aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorH.J. Lu <hongjiu.lu@intel.com>2008-08-01 19:02:43 +0000
committerH.J. Lu <hongjiu.lu@intel.com>2008-08-01 19:02:43 +0000
commit377e8e6c782954be98ef549ff93c5623fb0767dd (patch)
tree876c8d479cfe03a5e9fde83074bd636cd31a6643
parent7ca990edc48056c62e8fb3b8cd55660e2d688db7 (diff)
Merged with trunk at revision 138528.
git-svn-id: https://gcc.gnu.org/svn/gcc/branches/ix86/avx@138531 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r--gcc/ChangeLog170
-rw-r--r--gcc/DATESTAMP2
-rw-r--r--gcc/Makefile.in1
-rw-r--r--gcc/ada/ChangeLog650
-rw-r--r--gcc/ada/adaint.c10
-rw-r--r--gcc/ada/arit64.c58
-rw-r--r--gcc/ada/back_end.adb2
-rw-r--r--gcc/ada/bindgen.adb84
-rw-r--r--gcc/ada/checks.adb35
-rw-r--r--gcc/ada/checks.ads6
-rw-r--r--gcc/ada/clean.adb39
-rw-r--r--gcc/ada/cstreams.c15
-rw-r--r--gcc/ada/directio.ads6
-rw-r--r--gcc/ada/einfo.adb4
-rw-r--r--gcc/ada/einfo.ads11
-rw-r--r--gcc/ada/exp_aggr.adb49
-rw-r--r--gcc/ada/exp_attr.adb183
-rw-r--r--gcc/ada/exp_ch4.adb14
-rw-r--r--gcc/ada/exp_ch6.adb85
-rw-r--r--gcc/ada/exp_ch9.adb2
-rw-r--r--gcc/ada/exp_disp.adb14
-rw-r--r--gcc/ada/fe.h2
-rw-r--r--gcc/ada/g-pehage.adb23
-rw-r--r--gcc/ada/g-pehage.ads28
-rw-r--r--gcc/ada/gcc-interface/Makefile.in10
-rw-r--r--gcc/ada/gcc-interface/ada-tree.h6
-rw-r--r--gcc/ada/gcc-interface/decl.c142
-rw-r--r--gcc/ada/gcc-interface/gigi.h16
-rw-r--r--gcc/ada/gcc-interface/misc.c1
-rw-r--r--gcc/ada/gcc-interface/trans.c245
-rw-r--r--gcc/ada/gcc-interface/utils.c324
-rw-r--r--gcc/ada/gcc-interface/utils2.c26
-rw-r--r--gcc/ada/gnat_rm.texi35
-rw-r--r--gcc/ada/gnat_ugn.texi54
-rw-r--r--gcc/ada/gnatchop.adb60
-rw-r--r--gcc/ada/init.c1
-rw-r--r--gcc/ada/ioexcept.ads6
-rw-r--r--gcc/ada/lib-xref.adb6
-rw-r--r--gcc/ada/makeutl.adb10
-rw-r--r--gcc/ada/mlib-tgt-specific-vms-alpha.adb39
-rw-r--r--gcc/ada/mlib-tgt-specific-vms-ia64.adb78
-rw-r--r--gcc/ada/mlib-utl.adb24
-rw-r--r--gcc/ada/mlib-utl.ads17
-rw-r--r--gcc/ada/par-ch3.adb27
-rw-r--r--gcc/ada/par-prag.adb4
-rw-r--r--gcc/ada/prj-attr.adb1
-rw-r--r--gcc/ada/prj-env.adb44
-rw-r--r--gcc/ada/prj-makr.ads5
-rw-r--r--gcc/ada/prj-nmsc.adb1019
-rw-r--r--gcc/ada/prj-part.adb23
-rw-r--r--gcc/ada/prj-part.ads26
-rw-r--r--gcc/ada/prj-util.ads10
-rw-r--r--gcc/ada/prj.adb361
-rw-r--r--gcc/ada/prj.ads302
-rw-r--r--gcc/ada/rtsfind.ads24
-rw-r--r--gcc/ada/s-direio.adb10
-rw-r--r--gcc/ada/s-finimp.ads6
-rwxr-xr-xgcc/ada/s-os_lib.adb26
-rw-r--r--gcc/ada/s-parame-vxworks.adb4
-rwxr-xr-xgcc/ada/s-regexp.ads4
-rw-r--r--gcc/ada/s-rident.ads1
-rw-r--r--gcc/ada/s-stausa.adb58
-rw-r--r--gcc/ada/s-stausa.ads4
-rw-r--r--gcc/ada/s-ststop.adb380
-rw-r--r--gcc/ada/s-ststop.ads50
-rw-r--r--gcc/ada/scans.ads3
-rw-r--r--gcc/ada/scng.adb3
-rw-r--r--gcc/ada/sem_aggr.adb12
-rw-r--r--gcc/ada/sem_attr.adb29
-rw-r--r--gcc/ada/sem_ch10.adb32
-rw-r--r--gcc/ada/sem_ch12.adb72
-rw-r--r--gcc/ada/sem_ch12.ads10
-rw-r--r--gcc/ada/sem_ch4.adb47
-rw-r--r--gcc/ada/sem_ch6.adb222
-rw-r--r--gcc/ada/sem_mech.adb82
-rw-r--r--gcc/ada/sem_mech.ads10
-rw-r--r--gcc/ada/sem_prag.adb429
-rw-r--r--gcc/ada/sem_res.adb65
-rw-r--r--gcc/ada/sem_type.adb9
-rw-r--r--gcc/ada/sem_util.ads2
-rw-r--r--gcc/ada/sequenio.ads6
-rw-r--r--gcc/ada/sinput.adb4
-rw-r--r--gcc/ada/sinput.ads12
-rw-r--r--gcc/ada/snames.adb2
-rw-r--r--gcc/ada/snames.ads854
-rw-r--r--gcc/ada/snames.h4
-rw-r--r--gcc/ada/tbuild.ads4
-rw-r--r--gcc/ada/treepr.adb49
-rw-r--r--gcc/ada/types.ads2
-rw-r--r--gcc/ada/types.h9
-rw-r--r--gcc/ada/vms_data.ads10
-rw-r--r--gcc/ada/xref_lib.adb1
-rw-r--r--gcc/builtins.c29
-rw-r--r--gcc/c-pch.c3
-rw-r--r--gcc/cfgexpand.c4
-rw-r--r--gcc/config.gcc5
-rw-r--r--gcc/config/i386/darwin.h3
-rw-r--r--gcc/config/i386/i386.c10
-rw-r--r--gcc/config/i386/i386.h6
-rw-r--r--gcc/config/mips/mips.c2
-rw-r--r--gcc/config/mips/mips.h97
-rw-r--r--gcc/config/sh/sh.c11
-rwxr-xr-xgcc/configure37
-rw-r--r--gcc/configure.ac6
-rw-r--r--gcc/cp/ChangeLog21
-rw-r--r--gcc/cp/cp-tree.h1
-rw-r--r--gcc/cp/init.c104
-rw-r--r--gcc/cp/rtti.c6
-rw-r--r--gcc/cp/tree.c45
-rw-r--r--gcc/cp/typeck.c2
-rw-r--r--gcc/doc/invoke.texi25
-rw-r--r--gcc/doc/passes.texi6
-rw-r--r--gcc/dwarf2out.c314
-rw-r--r--gcc/expr.c1
-rw-r--r--gcc/final.c3
-rw-r--r--gcc/function.c6
-rw-r--r--gcc/function.h17
-rw-r--r--gcc/gimplify.c2
-rw-r--r--gcc/libada-mk.in29
-rw-r--r--gcc/opts.c7
-rw-r--r--gcc/passes.c4
-rw-r--r--gcc/testsuite/ChangeLog132
-rw-r--r--gcc/testsuite/g++.dg/debug/namespace2.C8
-rw-r--r--gcc/testsuite/g++.dg/eh/async-unwind2.C254
-rw-r--r--gcc/testsuite/g++.dg/expr/anew4.C3
-rw-r--r--gcc/testsuite/g++.dg/init/value3.C31
-rw-r--r--gcc/testsuite/g++.dg/lookup/new1.C4
-rw-r--r--gcc/testsuite/g++.dg/rtti/typeid8.C26
-rw-r--r--gcc/testsuite/g++.dg/tree-ssa/new1.C42
-rw-r--r--gcc/testsuite/g++.dg/tree-ssa/pr31146-2.C2
-rw-r--r--gcc/testsuite/gcc.c-torture/compile/pr36988.c11
-rw-r--r--gcc/testsuite/gcc.dg/Wall.c3
-rw-r--r--gcc/testsuite/gcc.dg/Wno-all.c3
-rw-r--r--gcc/testsuite/gcc.dg/cpp/mi8.c8
-rw-r--r--gcc/testsuite/gcc.dg/cpp/mi8a.h1
-rw-r--r--gcc/testsuite/gcc.dg/cpp/mi8b.h4
-rw-r--r--gcc/testsuite/gcc.dg/cpp/mi8c.h4
-rw-r--r--gcc/testsuite/gcc.dg/cpp/mi8d.h1
-rw-r--r--gcc/testsuite/gcc.dg/free-1.c26
-rw-r--r--gcc/testsuite/gcc.dg/free-2.c26
-rw-r--r--gcc/testsuite/gcc.dg/pch/cpp-3.c13
-rw-r--r--gcc/testsuite/gcc.dg/pch/cpp-3.hs4
-rw-r--r--gcc/testsuite/gcc.dg/pch/cpp-3a.h4
-rw-r--r--gcc/testsuite/gcc.dg/pch/cpp-3b.h4
-rw-r--r--gcc/testsuite/gcc.dg/pr3074-1.c3
-rw-r--r--gcc/testsuite/gcc.dg/pr36997.c8
-rw-r--r--gcc/testsuite/gcc.dg/torture/pr36978.c14
-rw-r--r--gcc/testsuite/gcc.dg/torture/stackalign/pr16660-1.c6
-rw-r--r--gcc/testsuite/gcc.dg/uninit-1-O0.c30
-rw-r--r--gcc/testsuite/gcc.dg/uninit-10-O0.c109
-rw-r--r--gcc/testsuite/gcc.dg/uninit-11-O0.c42
-rw-r--r--gcc/testsuite/gcc.dg/uninit-12-O0.c12
-rw-r--r--gcc/testsuite/gcc.dg/uninit-13-O0.c10
-rw-r--r--gcc/testsuite/gcc.dg/uninit-14-O0.c20
-rw-r--r--gcc/testsuite/gcc.dg/uninit-15-O0.c20
-rw-r--r--gcc/testsuite/gcc.dg/uninit-2-O0.c52
-rw-r--r--gcc/testsuite/gcc.dg/uninit-3-O0.c33
-rw-r--r--gcc/testsuite/gcc.dg/uninit-4-O0.c52
-rw-r--r--gcc/testsuite/gcc.dg/uninit-5-O0.c39
-rw-r--r--gcc/testsuite/gcc.dg/uninit-6-O0.c47
-rw-r--r--gcc/testsuite/gcc.dg/uninit-8-O0.c32
-rw-r--r--gcc/testsuite/gcc.dg/uninit-9-O0.c41
-rw-r--r--gcc/testsuite/gcc.dg/uninit-A-O0.c117
-rw-r--r--gcc/testsuite/gcc.dg/uninit-B-O0.c15
-rw-r--r--gcc/testsuite/gcc.dg/uninit-C-O0.c21
-rw-r--r--gcc/testsuite/gcc.dg/uninit-D-O0.c9
-rw-r--r--gcc/testsuite/gcc.dg/uninit-E-O0.c9
-rw-r--r--gcc/testsuite/gcc.dg/uninit-F-O0.c9
-rw-r--r--gcc/testsuite/gcc.dg/uninit-G-O0.c9
-rw-r--r--gcc/testsuite/gcc.dg/uninit-H-O0.c33
-rw-r--r--gcc/testsuite/gcc.dg/uninit-I-O0.c8
-rw-r--r--gcc/testsuite/gcc.target/mips/ext-1.c18
-rw-r--r--gcc/testsuite/gcc.target/powerpc/longcall-1.c13
-rw-r--r--gcc/testsuite/gnat.dg/boolean_expr1.adb30
-rw-r--r--gcc/testsuite/gnat.dg/boolean_expr1.ads5
-rw-r--r--gcc/testsuite/gnat.dg/deferred_const1.adb12
-rw-r--r--gcc/testsuite/gnat.dg/deferred_const2.adb11
-rw-r--r--gcc/testsuite/gnat.dg/deferred_const2_pkg.adb11
-rw-r--r--gcc/testsuite/gnat.dg/deferred_const2_pkg.ads12
-rw-r--r--gcc/testsuite/gnat.dg/deferred_const3.adb19
-rw-r--r--gcc/testsuite/gnat.dg/deferred_const3_pkg.adb19
-rw-r--r--gcc/testsuite/gnat.dg/deferred_const3_pkg.ads21
-rw-r--r--gcc/testsuite/gnat.dg/discr10.adb8
-rw-r--r--gcc/testsuite/gnat.dg/discr10.ads23
-rw-r--r--gcc/testsuite/gnat.dg/missing_acc_check.adb39
-rw-r--r--gcc/testsuite/gnat.dg/raise_from_pure.adb11
-rw-r--r--gcc/testsuite/gnat.dg/raise_from_pure.ads5
-rw-r--r--gcc/testsuite/gnat.dg/specs/genericppc.ads7
-rw-r--r--gcc/testsuite/gnat.dg/specs/null_aggr_bug.ads20
-rw-r--r--gcc/testsuite/gnat.dg/specs/sync_iface_test.ads14
-rw-r--r--gcc/testsuite/gnat.dg/sync_iface_test.adb19
-rw-r--r--gcc/testsuite/gnat.dg/sync_iface_test.ads11
-rw-r--r--gcc/testsuite/gnat.dg/test_raise_from_pure.adb9
-rw-r--r--gcc/testsuite/gnat.dg/wrap_raise_from_pure.adb10
-rw-r--r--gcc/testsuite/gnat.dg/wrap_raise_from_pure.ads4
-rw-r--r--gcc/tree-pass.h3
-rw-r--r--gcc/tree-ssa-ccp.c8
-rw-r--r--gcc/tree-ssa-loop-ivcanon.c15
-rw-r--r--gcc/tree-ssa-loop-unswitch.c4
-rw-r--r--gcc/tree-ssa-pre.c6
-rw-r--r--gnattools/ChangeLog11
-rw-r--r--gnattools/Makefile.in17
-rwxr-xr-xgnattools/configure983
-rw-r--r--gnattools/configure.ac7
-rw-r--r--libada/ChangeLog13
-rw-r--r--libada/Makefile.in36
-rwxr-xr-xlibada/configure983
-rw-r--r--libada/configure.ac14
-rw-r--r--libcpp/ChangeLog10
-rw-r--r--libcpp/files.c55
-rw-r--r--libiberty/ChangeLog12
-rw-r--r--libiberty/make-temp-file.c12
-rw-r--r--libiberty/mkstemps.c7
-rw-r--r--libstdc++-v3/ChangeLog30
-rw-r--r--libstdc++-v3/Makefile.in1
-rw-r--r--libstdc++-v3/acinclude.m417
-rwxr-xr-xlibstdc++-v3/configure149
-rw-r--r--libstdc++-v3/doc/Makefile.in1
-rw-r--r--libstdc++-v3/include/Makefile.in1
-rw-r--r--libstdc++-v3/include/std/chrono65
-rw-r--r--libstdc++-v3/libmath/Makefile.in1
-rw-r--r--libstdc++-v3/libsupc++/Makefile.in1
-rw-r--r--libstdc++-v3/po/Makefile.in1
-rw-r--r--libstdc++-v3/src/Makefile.am6
-rw-r--r--libstdc++-v3/src/Makefile.in9
-rw-r--r--libstdc++-v3/testsuite/20_util/duration/cons/1_neg.cc4
-rw-r--r--libstdc++-v3/testsuite/20_util/duration/requirements/typedefs_neg1.cc45
-rw-r--r--libstdc++-v3/testsuite/20_util/duration/requirements/typedefs_neg2.cc46
-rw-r--r--libstdc++-v3/testsuite/20_util/duration/requirements/typedefs_neg3.cc47
-rw-r--r--libstdc++-v3/testsuite/Makefile.in1
-rw-r--r--libstdc++-v3/testsuite/lib/libstdc++.exp31
231 files changed, 8718 insertions, 3471 deletions
diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index d7094e2a9e4..8ce1e665a3f 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,173 @@
+2008-08-01 H.J. Lu <hongjiu.lu@intel.com>
+
+ * cfgexpand.c (expand_stack_alignment): Assert that
+ stack_realign_drap and drap_rtx must match.
+
+ * function.c (instantiate_new_reg): If DRAP is used to realign
+ stack, replace virtual_incoming_args_rtx with internal arg
+ pointer.
+
+2008-08-01 Richard Guenther <rguenther@suse.de>
+
+ * tree-ssa-pre.c (fini_pre): Take in_fre parameter. Free
+ loop information only if we initialized it.
+ (execute_pre): Call fini_pre with in_fre.
+ * tree-ssa-loop-ivcanon (try_unroll_loop_completely): Dump
+ if we do not unroll because we hit max-completely-peeled-insns.
+ Use our estimation for consistency, do allow shrinking.
+
+2008-08-01 H.J. Lu <hongjiu.lu@intel.com>
+
+ * config/i386/i386.c (override_options): Replace ABI_STACK_BOUNDARY
+ with MIN_STACK_BOUNDARY.
+ (ix86_update_stack_boundary): Likewise.
+ (ix86_expand_prologue): Assert MIN_STACK_BOUNDARY instead of
+ STACK_BOUNDARY.
+
+ * config/i386/i386.h (ABI_STACK_BOUNDARY): Renamed to ...
+ (MIN_STACK_BOUNDARY): This.
+
+2008-08-01 Richard Guenther <rguenther@suse.de>
+
+ PR middle-end/36997
+ * gimplify.c (gimplify_call_expr): Set error_mark_node on GS_ERROR.
+
+2008-08-01 Richard Guenther <rguenther@suse.de>
+
+ PR tree-optimization/36988
+ * tree-ssa-ccp.c (ccp_fold): Conversions of constants only
+ do not matter if that doesn't change volatile qualification.
+
+2008-08-01 Paolo Bonzini <bonzini@gnu.org>
+
+ * configure.ac: Do not generate libada-mk. Do not subst
+ host_cc_for_libada.
+ * libada-mk.in: Remove.
+ * Makefile.in: Pass TARGET_LIBGCC2_CFLAGS to libgcc.mvars.
+ * configure: Regenerate.
+
+2008-08-01 Basile Starynkevitch <basile@starynkevitch.net>
+
+ * tree-pass.h: Added comment about not dumping passes with name
+ starting with star in struct opt_pass.
+ * passes.c (register_dump_files_1): Don't do dump for a pass with
+ name starting with star.
+ * doc/passes.texi (Pass manager): Mention pass names and special
+ meaning of star prefix to avoid dump.
+
+2008-07-31 Adam Nemet <anemet@caviumnetworks.com>
+
+ * config.gcc (mipsisa64r2*-*-linux*): New configuration. Set ISA
+ to MIPS64r2.
+ * config/mips/mips.h (GENERATE_MIPS16E): Update comment.
+ (ISA_MIPS64R2): New macro.
+ (TARGET_CPU_CPP_BUILTINS, MULTILIB_ISA_DEFAULT): Handle it.
+ (ISA_HAS_64BIT_REGS, ISA_HAS_MUL3, ISA_HAS_FP_CONDMOVE,
+ ISA_HAS_8CC, ISA_HAS_FP4, ISA_HAS_PAIRED_SINGLE,
+ ISA_HAS_MADD_MSUB, ISA_HAS_NMADD4_NMSUB4, ISA_HAS_CLZ_CLO,
+ ISA_HAS_ROR, ISA_HAS_PREFETCH, ISA_HAS_PREFETCHX, ISA_HAS_SEB_SEH,
+ ISA_HAS_EXT_INS, ISA_HAS_MXHC1, ISA_HAS_HILO_INTERLOCKS,
+ ISA_HAS_SYNCI, MIN_FPRS_PER_FMT): Return true for ISA_MIPS64R2.
+ (MIPS_ISA_LEVEL_SPEC, ASM_SPEC, LINK_SPEC): Handle -mips64r2.
+ (TARGET_LOONGSON_2E, TARGET_LOONGSON_2F, TARGET_LOONGSON_2EF):
+ Move up to keep list alphabetically sorted.
+ (TUNE_20KC, TUNE_24K, TUNE_74K, TUNE_LOONGSON_2EF): Likewise.
+ * config/mips/mips.c (mips_cpu_info_table): Add default MIPS64r2
+ processor.
+ * doc/invoke.texi (MIPS Options): Add -mips64r2.
+ (-march=@var{arch}): Add mips64r2.
+
+2008-07-31 H.J. Lu <hongjiu.lu@intel.com>
+
+ * config/i386/darwin.h (MAIN_STACK_BOUNDARY): Define to 128.
+
+2008-07-31 Steve Ellcey <sje@cup.hp.com>
+
+ * expr.c (expand_assignment): Check for complete type.
+
+2008-07-31 H.J. Lu <hongjiu.lu@intel.com>
+
+ PR debug/36977
+ * cfgexpand.c (expand_stack_alignment): Set stack_realign_tried.
+
+ * dwarf2out.c (based_loc_descr): Check crtl->stack_realign_tried
+ for stack alignment.
+
+ * function.h (rtl_data): Add stack_realign_tried. Update
+ comments.
+
+2008-07-31 Kaz Kojima <kkojima@gcc.gnu.org>
+
+ * config/sh/sh.c (sh_canonical_va_list_type): Remove.
+ (TARGET_CANONICAL_VA_LIST_TYPE): Remove.
+
+2008-07-31 Jakub Jelinek <jakub@redhat.com>
+
+ PR rtl-optimization/36419
+ * dwarf2out.c (barrier_args_size): New variable.
+ (compute_barrier_args_size, compute_barrier_args_size_1): New
+ functions.
+ (dwarf2out_stack_adjust): For BARRIERs call compute_barrier_args_size
+ if not called yet in the current function, use barrier_args_size
+ array to find the new args_size value.
+ (dwarf2out_frame_debug): Free and clear barrier_args_size.
+
+2008-07-31 H.J. Lu <hongjiu.lu@intel.com>
+
+ PR debug/36980
+ * dwarf2out.c (dwarf2out_frame_debug_expr): Move rule 17 before
+ rule 19.
+
+2008-07-31 H.J. Lu <hongjiu.lu@intel.com>
+
+ PR debug/36976
+ * dwarf2out.c (dwarf2out_args_size_adjust): New.
+ (dwarf2out_stack_adjust): Use it.
+ (dwarf2out_frame_debug_expr): Likewise.
+
+2008-07-31 Richard Guenther <rguenther@suse.de>
+
+ PR tree-optimization/36978
+ * tree-ssa-loop-unswitch.c (tree_may_unswitch_on): Do not fold
+ the generated condition.
+
+2008-07-31 Richard Guenther <rguenther@suse.de>
+
+ * passes.c (init_optimization_passes): Always call
+ pass_early_warn_uninitialized.
+ * opts.c (decode_options): Do not warn about -Wuninitialized
+ at -O0.
+ * doc/invoke.texi (-Wuninitialized): Correct for enabling at -O0.
+ * doc/passes.texi (Warn for uninitialized variables): Adjust.
+
+2008-07-31 Jakub Jelinek <jakub@redhat.com>
+
+ PR c/36970
+ * builtins.c (maybe_emit_free_warning): New function.
+ (expand_builtin): Process BUILT_IN_FREE even at -O0. Call
+ maybe_emit_free_warning for BUILT_IN_FREE.
+
+ PR debug/36278
+ * dwarf2out.c (get_context_die): New function.
+ (force_decl_die, force_type_die): Use it.
+ (dwarf2out_imported_module_or_decl): Likewise. If base_type_die
+ returns NULL, force generation of DW_TAG_typedef and put that into
+ DW_AT_import.
+
+ PR preprocessor/36649
+ * c-pch.c (c_common_read_pch): Save and restore
+ line_table->trace_includes across PCH restore.
+
+2008-07-30 Eric Botcazou <ebotcazou@adacore.com>
+
+ PR ada/36554
+ * dwarf2out.c (is_subrange_type): Deal with BOOLEAN_TYPE.
+
+2008-07-30 Rafael Avila de Espindola <espindola@google.com>
+
+ PR 36974
+ * final.c (call_from_call_insn): Handle COND_EXEC.
+
2008-07-30 H.J. Lu <hongjiu.lu@intel.com>
* builtins.c (std_gimplify_va_arg_expr): Replace
diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP
index bbceca5500f..197e40ff3ef 100644
--- a/gcc/DATESTAMP
+++ b/gcc/DATESTAMP
@@ -1 +1 @@
-20080730
+20080801
diff --git a/gcc/Makefile.in b/gcc/Makefile.in
index 10193a150c9..479277a567b 100644
--- a/gcc/Makefile.in
+++ b/gcc/Makefile.in
@@ -1680,6 +1680,7 @@ libgcc.mvars: config.status Makefile $(LIB2ADD) $(LIB2ADD_ST) specs \
echo SHLIB_MAPFILES = '$(call srcdirify,$(SHLIB_MAPFILES))' >> tmp-libgcc.mvars
echo SHLIB_NM_FLAGS = '$(SHLIB_NM_FLAGS)' >> tmp-libgcc.mvars
echo LIBGCC2_CFLAGS = '$(LIBGCC2_CFLAGS)' >> tmp-libgcc.mvars
+ echo TARGET_LIBGCC2_CFLAGS = '$(TARGET_LIBGCC2_CFLAGS)' >> tmp-libgcc.mvars
echo LIBGCC_SYNC = '$(LIBGCC_SYNC)' >> tmp-libgcc.mvars
echo LIBGCC_SYNC_CFLAGS = '$(LIBGCC_SYNC_CFLAGS)' >> tmp-libgcc.mvars
echo CRTSTUFF_CFLAGS = '$(CRTSTUFF_CFLAGS)' >> tmp-libgcc.mvars
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b000c134db6..5819c4948dc 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,647 @@
+2008-08-01 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gcc-interface/ada-tree.h (DECL_PARM_ALT): Now DECL_PARM_ALT_TYPE.
+ * gcc-interface/decl.c (gnat_to_gnu_param): Fix formatting, simplify
+ and adjust for above renaming.
+ * gcc-interface/utils.c (convert_vms_descriptor): Likewise. Add new
+ gnu_expr_alt_type parameter. Convert the expression to it instead
+ of changing its type in place.
+ (build_function_stub): Adjust call to above function.
+
+2008-08-01 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Constant>: Remove dead
+ code. Do not get full definition of deferred constants with address
+ clause for a use. Do not ignore deferred constant definitions with
+ address clause. Ignore constant definitions already marked with the
+ error node.
+ <object>: Remove obsolete comment. For a deferred constant with
+ address clause, get the initializer from the full view.
+ * gcc-interface/trans.c (gnat_to_gnu) <N_Attribute_Definition_Clause>:
+ Rework and remove obsolete comment.
+ <N_Object_Declaration>: For a deferred constant with address clause,
+ mark the full view with the error node.
+ * gcc-interface/utils.c (convert_to_fat_pointer): Rework and fix
+ formatting nits.
+
+2008-08-01 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * rtsfind.ads: Add block IO versions of stream routines for Strings.
+
+ * bindgen.adb, gnat_rm.texi, gnat_ugn.texi, opt.ads,
+ sem_prag.adb, snames.adb, snames.ads, snames.h,
+ par-prag.adb: Undo previous stream related changes.
+
+ * s-rident.ads: Add new restriction No_Stream_Optimizations.
+
+ * s-ststop.ads, s-ststop.adb: Comment reformatting.
+ Define enumeration type to designate different IO mechanisms.
+ Enchance generic package Stream_Ops_Internal to include an
+ implementation of Input and Output.
+
+ * exp_attr.adb (Find_Stream_Subprogram): If restriction
+ No_Stream_Optimization is active, choose the default byte IO
+ implementations of stream attributes for Strings.
+ Otherwise use the corresponding block IO version.
+
+2008-08-01 Olivier Hainque <hainque@adacore.com>
+
+ * gcc-interface/decl.c (gnat_to_gnu_entity) <case E_Function>: Do not
+ turn Ada Pure into GCC const, now implicitely implying nothrow as well.
+
+2008-08-01 Robert Dewar <dewar@adacore.com>
+
+ * par-ch3.adb (P_Defining_Identifier): Avoid repeated attempt to
+ convert plain identifier into defining identifier.
+
+2008-08-01 Robert Dewar <dewar@adacore.com>
+
+ * sem_prag.adb (Check_Form_Of_Interface_Name): Refine and improve
+ warnings
+
+ * lib-xref.adb: Add error defense.
+
+2008-08-01 Bob Duff <duff@adacore.com>
+
+ * ioexcept.ads, sequenio.ads, directio.ads: Correct comment.
+
+2008-08-01 Gary Dismukes <dismukes@adacore.com>
+
+ * exp_ch6.adb (Expand_Call): Adjustment to previous fix for passing
+ correct accessibility levels. In the "when others" case, retrieve the
+ access level of the Etype of Prev rather than Prev_Orig, because the
+ original exression has not always been analyzed.
+
+2008-08-01 Robert Dewar <dewar@adacore.com>
+
+ * prj-nmsc.adb: Minor reformatting
+
+ * sem_ch4.adb: Minor reformatting
+ Minor code reorganization
+
+ * prj.ads: Minor reformatting
+
+ * s-os_lib.adb: Minor reformatting
+
+ * par-prag.adb (Prag, case Wide_Character_Encoding): Deal with upper
+ half encodings
+
+ * scans.ads: Minor reformatting.
+
+ * sem_prag.adb (Analyze_Pragma): Put entries in alpha order
+ (Analyze_Pragma): Make sure all GNAT pragmas call GNAT_Pragma
+
+ * sem_res.adb:
+ (Resolve_Call): Check violation of No_Specific_Termination_Handlers
+
+ * sem_ch12.adb: Minor comment reformatting
+
+ * par-ch3.adb (P_Type_Declaration): Properly handle missing type
+ keyword
+
+2008-08-01 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch6.adb (Process_PPCs): Don't copy spec PPC to body if not
+ generating code
+
+2008-08-01 Ed Schonberg <schonberg@adacore.com>
+
+ * checks.adb (Apply_Float_Conversion_Check): If the expression to be
+ converted is a real literal and the target type has static bounds,
+ perform the conversion exactly to prevent floating-point anomalies on
+ some targets.
+
+2008-08-01 Vincent Celier <celier@adacore.com>
+
+ * prj-attr.adb: New attribute Compiler'Name_Syntax (<lang>)
+
+ * prj-nmsc.adb (Process_Compiler): Recognize attribute Name_Syntax
+
+ * prj.adb (Object_Exist_For): Use Object_Generated, not
+ Objects_Generated that is removed and was never modified anyway.
+
+ * prj.ads:
+ (Path_Syntax_Kind): New enumeration type
+ (Language_Config): New component Path_Syntax, defaulted to Host.
+ Components PIC_Option and Objects_Generated removed, as they are not
+ used.
+
+ * snames.adb: New standard name Path_Syntax
+
+ * snames.ads: New standard name Path_Syntax
+
+2008-08-01 Vincent Celier <celier@adacore.com>
+
+ * mlib-utl.adb:
+ (Adalib_Path): New variable to store the path of the adalib directory
+ when procedure Specify_Adalib_Dir is called.
+ (Lib_Directory): If Adalib_Path is not null, return its value
+ (Specify_Adalib_Dir): New procedure
+
+ * mlib-utl.ads (Specify_Adalib_Dir): New procedure
+
+2008-08-01 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_prag.adb:
+ (Check_Precondition_Postcondition): If not generating code, analyze the
+ expression in a postcondition that appears in a subprogram body, so that
+ it is properly decorated for ASIS use.
+
+2008-08-01 Gary Dismukes <dismukes@adacore.com>
+
+ * exp_ch6.adb (Expand_Call): Remove ugly special-case code that resets
+ Orig_Prev to Prev in the case where the actual is N_Function_Call or
+ N_Identifier. This was interfering with other cases that are rewritten
+ as N_Identifier, such as allocators, resulting in passing of the wrong
+ accessibility level, and based on testing this code is apparently no
+ longer needed at all.
+
+2008-08-01 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch4.adb (Analyze_One_Call): Handle complex overloading of a
+ procedure call whose prefix
+ is a parameterless function call that returns an access_to_procedure.
+
+2008-08-01 Jose Ruiz <ruiz@adacore.com>
+
+ * adaint.c (__gnat_tmp_name): Refine the generation of temporary names
+ for RTX. Adding a suffix that is incremented at each iteration.
+
+2008-08-01 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch6.adb (Analyze_Subprogram_Body): Remove special casing of
+ Raise_Exception
+
+2008-08-01 Jerome Lambourg <lambourg@adacore.com>
+
+ * s-os_lib.adb (Normalize_Pathname): Take care of double-quotes in
+ paths, which are authorized by Windows but can lead to errors when used
+ elsewhere.
+
+2008-08-01 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch12.ads (Need_Subprogram_Instance_Body): new function, to create
+ a pending instantiation for the body of a subprogram that is to be
+ inlined.
+
+ * sem_ch12.adb:
+ (Analyze_Subprogram_Instantiation): use Need_Subprogram_Instance_Body.
+
+ * sem_prag.adb (Make_Inline): If the pragma applies to an instance,
+ create a pending instance for its body, so that calls to the subprogram
+ can be inlined by the back-end.
+
+2008-08-01 Jose Ruiz <ruiz@adacore.com>
+
+ * gnat_ugn.texi: Document the RTX run times (rts-rtx-rtss and
+ rts-rtx-w32).
+
+2008-08-01 Robert Dewar <dewar@adacore.com>
+
+ * scng.adb (Error_Illegal_Wide_Character): Bump scan pointer
+
+2008-08-01 Doug Rupp <rupp@adacore.com>
+
+ * gnat_rm.texi: Document new mechanism Short_Descriptor.
+
+ * types.ads (Mechanism_Type): Modify range for new Short_Descriptor
+ mechanism values.
+
+ * sem_prag.adb (Set_Mechanism_Value): Enhance for Short_Descriptor
+ mechanism and Short_Descriptor mechanism values.
+
+ * snames.adb (preset_names): Add short_descriptor entry.
+
+ * snames.ads: Add Name_Short_Descriptor.
+
+ * types.h: Add new By_Short_Descriptor mechanism values.
+
+ * sem_mech.adb (Set_Mechanism_Value): Enhance for Short_Descriptor
+ mechanism and Short_Descriptor mechanism values.
+
+ * sem_mech.ads (Mechanism_Type): Add new By_Short_Descriptor mechanism
+ values.
+ (Descriptor_Codes): Modify range for new mechanism values.
+
+ * treepr.adb (Print_Entity_Enfo): Handle new By_Short_Descriptor
+ mechanism values.
+
+ * gcc-interface/decl.c (gnat_to_gnu_entity): Handle By_Short_Descriptor.
+ (gnat_to_gnu_param): Handle By_Short_Descriptor.
+
+ * gcc-interface/gigi.h (build_vms_descriptor64): Remove prototype.
+ (build_vms_descriptor32): New prototype.
+ (fill_vms_descriptor): Remove unneeded gnat_actual parameter.
+
+ * gcc-interface/trans.c (call_to_gnu): Removed unneeded gnat_actual
+ argument in call fill_vms_descriptor.
+
+ * gcc-interface/utils.c (build_vms_descriptor32): Renamed from
+ build_vms_descriptor and enhanced to hande Short_Descriptor mechanism.
+ (build_vms_descriptor): Renamed from build_vms_descriptor64.
+ (convert_vms_descriptor32): New function.
+ (convert_vms_descriptor64): New function.
+ (convert_vms_descriptor): Rewrite to handle both 32bit and 64bit
+ descriptors.
+
+ * gcc-interface/utils2.c (fill_vms_descriptor): Revert previous changes,
+ no longer needed.
+
+2008-08-01 Jose Ruiz <ruiz@adacore.com>
+
+ * adaint.c (__gnat_tmp_name): RTSS applications do not support tempnam
+ nor tmpnam, so we always use c:\WINDOWS\Temp\gnat-XXXXXX as temporary
+ name.
+
+2008-08-01 Jose Ruiz <ruiz@adacore.com>
+
+ * cstreams.c (__gnat_full_name): RTSS applications cannot ask for the
+ current directory so only fully qualified names are allowed.
+
+2008-08-01 Robert Dewar <dewar@adacore.com>
+
+ * gnat_ugn.texi:
+ Minor editing, remove uncomfortable use of semicolon
+
+ * s-ststop.adb: Add some ??? comments
+
+ * sem_ch10.adb: Minor reformatting
+
+ * snames.ads:
+ Minor comment fixes, some pragmas were not properly
+ categorized in the comments, documentation change only
+
+ * xref_lib.adb: Minor reformatting
+
+ * sinput.adb: Minor reformatting
+
+ * gnatchop.adb: Minor reformatting
+
+ * sem_util.ads: Minor reformatting.
+
+ * opt.ads: Minor documentation fix
+
+ * scng.adb: Minor reformatting
+
+ * prj-part.adb: Update comments
+
+2008-08-01 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_disp.adb (Expand_Interface_Conversion): If the target type is a
+ tagged synchronized type, use corresponding record type.
+
+2008-08-01 Doug Rupp <rupp@adacore.com>
+
+ * mlib-tgt-specific-vms-alpha.adb (Build_Dynamic_Library): Output a
+ dummy transfer address for debugging.
+
+ * mlib-tgt-specific-vms-ia64.adb (Build_Dynamic_Library): Likewise.
+
+ * vms_data.ads: vms_data.ads: New qualfier /MACHINE_CODE_LISTING
+
+2008-07-31 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gcc-interface/decl.c (gnat_to_gnu_entity): Fix formatting.
+ * gcc-interface/utils.c (create_field_decl): Avoid superfluous work.
+
+2008-07-31 Pascal Obry <obry@adacore.com>
+
+ * prj-nmsc.adb: Keep Object and Exec directory casing.
+
+2008-07-31 Jose Ruiz <ruiz@adacore.com>
+
+ * system-rtx-rtss.ads
+ Change the default stack size. It is important to set the commit part.
+
+ * s-taprop-rtx.adb
+ (Initialize): Get the clock resolution.
+ (RT_Resolution): Return the clock resolution that is indicated by the
+ system.
+
+ * s-parame-vxworks.adb
+ Document that this body is used for RTX in RTSS (kernel) mode.
+
+ * gcc-interface/Makefile.in
+ (LIBGNAT_TARGET_PAIRS for the rtx_rtss run time): Use the
+ s-parame-vxworks.adb body in order to have reasonable stack sizes in
+ RTX RTSS kernel mode. Virtual memory is not used in that case, so we
+ cannot ask for too big values.
+
+2008-07-31 Robert Dewar <dewar@adacore.com>
+
+ * exp_aggr.adb: Minor reformatting
+
+ * makeutl.adb: Minor reformatting
+
+ * prj-env.adb: Minor reformatting
+
+2008-07-31 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_disp.adb (Prim_Op_Kind): Retrieve the full view when a private
+ tagged type is completed by a concurrent type.
+
+2008-07-31 Gary Dismukes <dismukes@adacore.com>
+
+ * sem_aggr.adb:
+ (Resolve_Record_Aggregate): Bypass error that a type without
+ components must have a "null record" aggregate when compiling for Ada
+ 2005, since it's legal to give an aggregate of form (others => <>)
+ for such a type.
+
+2008-07-31 Javier Miranda <miranda@adacore.com>
+
+ * sem_ch4.adb (Valid_First_Argument_Of): Complete its functionality to
+ handle synchronized types. Required to handle well the object.operation
+ notation applied to synchronized types.
+
+2008-07-31 Quentin Ochem <ochem@adacore.com>
+
+ * s-stausa.adb (Fill_Stack): Stack_Used_When_Filling is now stored
+ anymore - just used internally.
+ Added handling of very small tasks - when the theoretical size is
+ already full at the point of the call.
+ (Report_Result): Fixed result computation, Stack_Used_When_Filling does
+ not need to be added to the result.
+
+2008-07-31 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch6.adb (Disambiguate_Spec): Continue the disambiguation if the
+ corresponding spec is a primitive wrapper. Update comment.
+
+2008-07-31 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * bindgen.adb Comment reformatting. Update the list of run-time globals.
+ (Gen_Adainit_Ada): Add the declaration, import and value set for
+ configuration flag Canonical_Streams.
+ (Gen_Adainit_C): Add the declaration and initial value of external
+ symbol __gl_canonical_streams.
+
+ * init.c: Update the list of global values computed by the binder.
+
+ * opt.ads: Add flag Canonical_Streams.
+
+ * par-prag.adb (Prag): Include Pragma_Canonical_Streams to the list of
+ semantically handled pragmas.
+
+ * sem_prag.adb: Add an entry into enumeration type Sig_Flags.
+ (Analyze_Pragma): Add case for pragma Canonical_Streams.
+
+ * snames.adb: Add character value for name Canonical_Streams.
+
+ * snames.ads:
+ Add Name_Canonical_Streams to the list of configuration pragmas.
+ Add Pragma_Canonical_Streams to enumeration type Pragma_Id.
+
+ * snames.h: Add a definition for Pragma_Canonical_Streams.
+
+ * s-ststop.adb:
+ Add a flag and import to seize the value of external symbol
+ __gl_canonical_streams. Update comment and initial value of constant
+ Use_Block_IO.
+
+ * gnat_rm.texi: Add section of pragma Canonical_Streams.
+
+ * gnat_ugn.texi:
+ Add pragma Canonical_Streams to the list of configuration pragmas.
+
+2008-07-31 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch10.adb (Build_Unit_Name): If the unit name in a with_clause
+ has the form A.B.C and B is a unit renaming, analyze its compilation
+ unit and add a with_clause on A.b to the context.
+
+2008-07-31 Vincent Celier <celier@adacore.com>
+
+ * makeutl.adb (Executable_Prefix_Path): If Locate_Exec_On_Path fails,
+ return the empty string, instead of raising Constraint_Error.
+
+2008-07-31 Gary Dismukes <dismukes@adacore.com>
+
+ * checks.ads (Apply_Accessibility_Check): Add parameter Insert_Node.
+
+ * checks.adb (Apply_Accessibility_Check): Insert the check on
+ Insert_Node.
+
+ * exp_attr.adb:
+ (Expand_N_Attribute_Refernce, Attribute_Access): Pass attribute node
+ to new parameter Insert_Node on call to Apply_Accessibility_Check.
+ Necessary to distinguish the insertion node because the dereferenced
+ formal may come from a rename, but the check must be inserted in
+ front of the attribute.
+
+ * exp_ch4.adb:
+ (Expand_N_Allocator): Pass actual for new Insert_Node parameter on
+ call to Apply_Accessibility_Check.
+ (Expand_N_Type_Conversion): Pass actual for new Insert_Node parameter
+ on call to Apply_Accessibility_Check.
+ Minor reformatting
+
+2008-07-31 Javier Miranda <miranda@adacore.com>
+
+ * sem_type.adb (Has_Compatible_Type): Complete support for synchronized
+ types when the candidate type is a synchronized type.
+
+ * sem_res.adb (Resolve_Actuals): Reorganize code handling synchronized
+ types, and complete management of synchronized types adding missing
+ code to handle formal that is a synchronized type.
+
+ * sem_ch4.adb (Try_Primitive_Operation): Avoid testing attributes that
+ are not available and cause the compiler to blowup. Found compiling
+ test with switch -gnatc
+
+ * sem_ch6.adb (Check_Synchronized_Overriding): Remove local subprogram
+ Has_Correct_Formal_Mode plus code cleanup.
+
+2008-07-31 Bob Duff <duff@adacore.com>
+
+ * sinput.adb (Skip_Line_Terminators): Fix handling of LF/CR -- it was
+ recognized as two end-of-lines, but it should be just one.
+
+2008-07-31 Thomas Quinot <quinot@adacore.com>
+
+ * exp_ch9.adb: Minor reformatting
+
+ * tbuild.ads: Fix several occurrences of incorrectly referring to
+ Name_Find as Find_Name.
+
+2008-07-31 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_aggr.adb (Aggr_Size_OK): If the aggregate has a single component
+ and the context is an object declaration with non-static bounds, treat
+ the aggregate as non-static.
+
+2008-07-31 Vincent Celier <celier@adacore.com>
+
+ * prj-part.adb, prj-part.ads, prj.adb, prj.ads, prj-env.adb:
+ Move back spec of Parse_Single_Project to body, as it is not called
+ outside of package Prj.Part.
+ (Project_Data): Remove components Linker_Name, Linker_Path and
+ Minimum_Linker_Options as they are no longer set.
+ Remove function There_Are_Ada_Sources from package Prj and move code
+ in the only place it was used, in Prj.Env.Set_Ada_Paths.
+
+2008-07-31 Arnaud Charlet <charlet@adacore.com>
+
+ * mlib-utl.ads: Fix typo.
+
+2008-07-31 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch12.adb: Minor reformatting
+
+2008-07-31 Sergey Rybin <rybin@adacore.com>
+
+ * gnat_ugn.texi: Change the description of the
+ Overly_Nested_Control_Structures: now the rule always requires a
+ positive parameter for '+R' option
+
+2008-07-31 Thomas Quinot <quinot@adacore.com>
+
+ * g-pehage.adb: Minor reformatting
+
+2008-07-31 Pascal Obry <obry@adacore.com>
+
+ * s-finimp.ads: Minor reformatting.
+
+2008-07-31 Vincent Celier <celier@adacore.com>
+
+ * s-regexp.ads: Minor comment fix
+
+2008-07-31 Arnaud Charlet <charlet@adacore.com>
+
+ * s-direio.adb (Reset): Replace pragma Unmodified by Warnings (Off),
+ so that we can compile this file successfully with -gnatc.
+
+2008-07-31 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_attr.adb (Find_Stream_Subprogram): Check the base type instead
+ of the type when looking for stream subprograms for type String,
+ Wide_String and Wide_Wide_String.
+
+ * s-ststop.adb: Change the initialization expression of constant
+ Use_Block_IO.
+
+2008-07-31 Geert Bosch <bosch@adacore.com>
+
+ * arit64.c:
+ New file implementing __gnat_mulv64 signed integer multiplication with
+ overflow checking
+
+ * fe.h (Backend_Overflow_Checks_On_Target): Define for use by Gigi
+
+ * gcc-interface/gigi.h:
+ (standard_types): Add ADT_mulv64_decl
+ (mulv64_decl): Define subprogram declaration for __gnat_mulv64
+
+ * gcc-interface/utils.c:
+ (init_gigi_decls): Add initialization of mulv64_decl
+
+ * gcc-interface/trans.c:
+ (build_unary_op_trapv): New function
+ (build_binary_op_trapv): New function
+ (gnat_to_gnu): Use the above functions instead of
+ build_{unary,binary}_op
+
+ * gcc-interface/Makefile.in
+ (LIBGNAT_SRCS): Add arit64.c
+ (LIBGNAT_OBJS): Add arit64.o
+
+2008-07-31 Vincent Celier <celier@adacore.com>
+
+ * prj-nmsc.adb (Check_Library_Attributes): Check if Linker'Switches or
+ Linker'Default_Switches are declared. Warn if they are declared.
+
+2008-07-31 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration): Use
+ Insert_Actions to place the pointer declaration in the code, rather
+ than Insert_Before_And_Analyze, so that insertions of temporaries are
+ kept in the proper order when transient scopes are present.
+
+
+2008-07-31 Robert Dewar <dewar@adacore.com>
+
+ * einfo.adb (Spec_PPC): Now defined for generic subprograms
+
+ * einfo.ads (Spec_PPC): Now defined for generic subprograms
+
+ * sem_prag.adb (Check_Precondition_Postcondition): Handle generic
+ subprogram case
+
+2008-07-31 Vincent Celier <celier@adacore.com>
+
+ * s-os_lib.adb: Minor comment fix
+
+2008-07-31 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch6.adb (Analyze_Generic_Subprogram_Body): After analysis,
+ transfer pre/postconditions from generic copy to original tree, so that
+ they will appear in each instance.
+ (Process_PPCs): Do not transform postconditions into a procedure in a
+ generic context, to prevent double expansion of check pragmas.
+
+ * sem_attr.adb: In an instance, the prefix of the 'result attribute
+ can be the renaming of the
+ current instance, so check validity of the name accordingly.
+
+2008-07-31 Robert Dewar <dewar@adacore.com>
+
+ * mlib-utl.ads: Minor reformatting
+
+2008-07-31 Ed Schonberg <schonberg@adacore.com>
+
+ sem_attr.adb: 'Result can have an ambiguous prefix, and is resolved
+ from context. This attribute must be usable in Ada95 mode.
+ The attribute can appear in the body of a function marked
+ Inline_Always, but in this case the postocondition is not enforced.
+
+ sem_prag.adb (Check_Precondition_Postcondition): within the expansion
+ of an inlined call pre- and postconditions are legal
+
+2008-07-31 Vincent Celier <celier@adacore.com>
+
+ * prj.adb, prj.ads, clean.adb, prj-nmsc.adb: Remove declarations that
+ were for gprmake only
+
+2008-07-31 Robert Dewar <dewar@adacore.com>
+
+ * gnat_ugn.texi: Update -gnatN documentation.
+
+ * gnat_rm.texi: Add note about pre/postcondition
+ pragmas not checked in conjunction with front-end inlining.
+
+2008-07-31 Robert Dewar <dewar@adacore.com>
+
+ * g-pehage.adb, g-pehage.ads: Minor reformatting
+
+2008-07-31 Arnaud Charlet <charlet@adacore.com>
+
+ * mlib-utl.ads, prj-makr.ads: Add comments.
+
+2008-07-30 Aaron W. LaFramboise <aaronavay62@aaronwl.com>
+
+ * gcc-interface/Makefile.in (EXTRA_GNATRTL_NONTASKING_OBJS)
+ [WINDOWS]: Add s-winext.o.
+
+2008-07-30 Eric Botcazou <ebotcazou@adacore.com>
+
+ PR ada/36554
+ * back_end.adb (Call_Back_End): Pass Standard_Boolean to gigi.
+ * gcc-interface/gigi.h (gigi): Take new standard_boolean parameter.
+ * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Enumeration_Subtype>:
+ Set precision to 1 for subtype of BOOLEAN_TYPE.
+ (set_rm_size): Set TYPE_RM_SIZE_NUM for BOOLEAN_TYPE.
+ (make_type_from_size): Deal with BOOLEAN_TYPE.
+ * gcc-interface/misc.c (gnat_print_type): Likewise.
+ * gcc-interface/trans.c (gigi): Take new standard_boolean parameter.
+ Set boolean_type_node as its translation in the table, as well
+ as boolean_false_node for False and boolean_true_node for True.
+ * gcc-interface/utils.c (gnat_init_decl_processing): Create custom
+ 8-bit boolean_type_node and set its TYPE_RM_SIZE_NUM.
+ (create_param_decl): Deal with BOOLEAN_TYPE.
+ (build_vms_descriptor): Likewise.
+ (build_vms_descriptor64): Likewise.
+ (convert): Deal with BOOLEAN_TYPE like with ENUMERAL_TYPE.
+
2008-07-30 Robert Dewar <dewar@adacore.com>
* exp_ch9.adb: Minor reformatting
@@ -16948,7 +17592,7 @@ PR ada/10768
* utils.c (create_var_decl): Use have_global_bss_p when deciding
whether to make the decl common.
-2006-02-20 Rafael Ávila de Espíndola <rafael.espindola@gmail.com>
+2006-02-20 Rafael �vila de Esp�ndola <rafael.espindola@gmail.com>
* Make-lang.in (Ada): Remove.
(.PHONY): Remove Ada
@@ -19406,11 +20050,11 @@ PR ada/10768
* s-bitops.adb: Clarify comment for Bits_Array
-2005-12-07 Rafael Ávila de Espíndola <rafael.espindola@gmail.com>
+2005-12-07 Rafael �vila de Esp�ndola <rafael.espindola@gmail.com>
* Make-lang.in (ada.install-normal): Remove.
-2005-12-07 Rafael Ávila de Espíndola <rafael.espindola@gmail.com>
+2005-12-07 Rafael �vila de Esp�ndola <rafael.espindola@gmail.com>
* Make-lang.in: Remove all dependencies on s-gtype.
diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index 29f649aa096..03a0ff435a9 100644
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -982,7 +982,15 @@ __gnat_named_file_length (char *name)
void
__gnat_tmp_name (char *tmp_filename)
{
-#ifdef __MINGW32__
+#ifdef RTX
+ /* Variable used to create a series of unique names */
+ static int counter = 0;
+
+ /* RTX in RTSS mode does not support tempnam nor tmpnam so we emulate it */
+ strcpy (tmp_filename, "c:\\WINDOWS\\Temp\\gnat-");
+ sprintf (&tmp_filename[strlen (tmp_filename)], "%d\0", counter++);
+
+#elif defined (__MINGW32__)
{
char *pname;
diff --git a/gcc/ada/arit64.c b/gcc/ada/arit64.c
new file mode 100644
index 00000000000..c21f67c9418
--- /dev/null
+++ b/gcc/ada/arit64.c
@@ -0,0 +1,58 @@
+/****************************************************************************
+ * *
+ * GNAT COMPILER COMPONENTS *
+ * *
+ * A R I T 6 4 . C *
+ * *
+ * C Implementation File *
+ * *
+ * Copyright (C) 2008, Free Software Foundation, Inc. *
+ * *
+ * GNAT is free software; you can redistribute it and/or modify it under *
+ * terms of the GNU General Public License as published by the Free Soft- *
+ * ware Foundation; either version 2, or (at your option) any later ver- *
+ * sion. GNAT is distributed in the hope that it will be useful, but WITH- *
+ * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
+ * or 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 distributed with GNAT; see file COPYING. If not, write *
+ * to the Free Software Foundation, 51 Franklin Street, Fifth Floor, *
+ * Boston, MA 02110-1301, USA. *
+ * *
+ * As a special exception, if you link this file with other files to *
+ * produce an executable, this file does not by itself cause the resulting *
+ * executable to be covered by the GNU General Public License. This except- *
+ * ion does not however invalidate any other reasons why the executable *
+ * file might be covered by the GNU Public License. *
+ * *
+ * GNAT was originally developed by the GNAT team at New York University. *
+ * Extensive contributions were provided by Ada Core Technologies Inc. *
+ * *
+ ****************************************************************************/
+
+extern void __gnat_rcheck_10(char *file, int line)
+ __attribute__ ((__noreturn__));
+
+long long int __gnat_mulv64 (long long int x, long long int y)
+{
+ unsigned neg = (x >= 0) ^ (y >= 0);
+ long long unsigned xa = x >= 0 ? (long long unsigned) x
+ : -(long long unsigned) x;
+ long long unsigned ya = y >= 0 ? (long long unsigned) y
+ : -(long long unsigned) y;
+ unsigned xhi = (unsigned) (xa >> 32);
+ unsigned yhi = (unsigned) (ya >> 32);
+ unsigned xlo = (unsigned) xa;
+ unsigned ylo = (unsigned) ya;
+ long long unsigned mid
+ = xhi ? (long long unsigned) xhi * (long long unsigned) ylo
+ : (long long unsigned) yhi * (long long unsigned) xlo;
+ long long unsigned low = (long long unsigned) xlo * (long long unsigned) ylo;
+
+ if ((xhi && yhi) || mid + (low >> 32) > 0x7fffffff + neg)
+ __gnat_rcheck_10 (__FILE__, __LINE__);
+
+ low += ((long long unsigned) (unsigned) mid) << 32;
+
+ return (long long int) (neg ? -low : low);
+}
diff --git a/gcc/ada/back_end.adb b/gcc/ada/back_end.adb
index a6600764988..7a4e4dadf0f 100644
--- a/gcc/ada/back_end.adb
+++ b/gcc/ada/back_end.adb
@@ -76,6 +76,7 @@ package body Back_End is
number_file : Nat;
file_info_ptr : Address;
+ gigi_standard_boolean : Entity_Id;
gigi_standard_integer : Entity_Id;
gigi_standard_long_long_float : Entity_Id;
gigi_standard_exception_type : Entity_Id;
@@ -112,6 +113,7 @@ package body Back_End is
number_file => Num_Source_Files,
file_info_ptr => File_Info_Array'Address,
+ gigi_standard_boolean => Standard_Boolean,
gigi_standard_integer => Standard_Integer,
gigi_standard_long_long_float => Standard_Long_Long_Float,
gigi_standard_exception_type => Standard_Exception_Type,
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index d29857fb5fc..070651cbd6a 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -127,38 +127,37 @@ package body Bindgen is
-- Default_Stack_Size : Integer;
-- Leap_Seconds_Support : Integer;
- -- Main_Priority is the priority value set by pragma Priority in the
- -- main program. If no such pragma is present, the value is -1.
-
- -- Time_Slice_Value is the time slice value set by pragma Time_Slice
- -- in the main program, or by the use of a -Tnnn parameter for the
- -- binder (if both are present, the binder value overrides). The
- -- value is in milliseconds. A value of zero indicates that time
- -- slicing should be suppressed. If no pragma is present, and no
- -- -T switch was used, the value is -1.
-
- -- WC_Encoding shows the wide character encoding method used for
- -- the main program. This is one of the encoding letters defined
- -- in System.WCh_Con.WC_Encoding_Letters.
-
- -- Locking_Policy is a space if no locking policy was specified
- -- for the partition. If a locking policy was specified, the value
- -- is the upper case first character of the locking policy name,
- -- for example, 'C' for Ceiling_Locking.
-
- -- Queuing_Policy is a space if no queuing policy was specified
- -- for the partition. If a queuing policy was specified, the value
- -- is the upper case first character of the queuing policy name
- -- for example, 'F' for FIFO_Queuing.
-
- -- Task_Dispatching_Policy is a space if no task dispatching policy
- -- was specified for the partition. If a task dispatching policy
- -- was specified, the value is the upper case first character of
- -- the policy name, e.g. 'F' for FIFO_Within_Priorities.
-
- -- Priority_Specific_Dispatching is the address of a string used to
- -- store the task dispatching policy specified for the different priorities
- -- in the partition. The length of this string is determined by the last
+ -- Main_Priority is the priority value set by pragma Priority in the main
+ -- program. If no such pragma is present, the value is -1.
+
+ -- Time_Slice_Value is the time slice value set by pragma Time_Slice in the
+ -- main program, or by the use of a -Tnnn parameter for the binder (if both
+ -- are present, the binder value overrides). The value is in milliseconds.
+ -- A value of zero indicates that time slicing should be suppressed. If no
+ -- pragma is present, and no -T switch was used, the value is -1.
+
+ -- WC_Encoding shows the wide character encoding method used for the main
+ -- program. This is one of the encoding letters defined in
+ -- System.WCh_Con.WC_Encoding_Letters.
+
+ -- Locking_Policy is a space if no locking policy was specified for the
+ -- partition. If a locking policy was specified, the value is the upper
+ -- case first character of the locking policy name, for example, 'C' for
+ -- Ceiling_Locking.
+
+ -- Queuing_Policy is a space if no queuing policy was specified for the
+ -- partition. If a queuing policy was specified, the value is the upper
+ -- case first character of the queuing policy name for example, 'F' for
+ -- FIFO_Queuing.
+
+ -- Task_Dispatching_Policy is a space if no task dispatching policy was
+ -- specified for the partition. If a task dispatching policy was specified,
+ -- the value is the upper case first character of the policy name, e.g. 'F'
+ -- for FIFO_Within_Priorities.
+
+ -- Priority_Specific_Dispatching is the address of a string used to store
+ -- the task dispatching policy specified for the different priorities in
+ -- the partition. The length of this string is determined by the last
-- priority for which such a pragma applies (the string will be a null
-- string if no specific dispatching policies were used). If pragma were
-- present, the entries apply to the priorities in sequence from the first
@@ -182,12 +181,12 @@ package body Bindgen is
-- such a pragma is given (the string will be a null string if no pragmas
-- were used). If pragma were present the entries apply to the interrupts
-- in sequence from the first interrupt, and are set to one of four
- -- possible settings: 'n' for not specified, 'u' for user, 'r' for
- -- run time, 's' for system, see description of Interrupt_State pragma
- -- for further details.
+ -- possible settings: 'n' for not specified, 'u' for user, 'r' for run
+ -- time, 's' for system, see description of Interrupt_State pragma for
+ -- further details.
- -- Num_Interrupt_States is the length of the Interrupt_States string.
- -- It will be set to zero if no Interrupt_State pragmas are present.
+ -- Num_Interrupt_States is the length of the Interrupt_States string. It
+ -- will be set to zero if no Interrupt_State pragmas are present.
-- Unreserve_All_Interrupts is set to one if at least one unit in the
-- partition had a pragma Unreserve_All_Interrupts, and zero otherwise.
@@ -201,13 +200,12 @@ package body Bindgen is
-- this partition, and to zero if longjmp/setjmp exceptions are used.
-- the use of zero
- -- Detect_Blocking indicates whether pragma Detect_Blocking is
- -- active or not. A value of zero indicates that the pragma is not
- -- present, while a value of 1 signals its presence in the
- -- partition.
+ -- Detect_Blocking indicates whether pragma Detect_Blocking is active or
+ -- not. A value of zero indicates that the pragma is not present, while a
+ -- value of 1 signals its presence in the partition.
- -- Default_Stack_Size is the default stack size used when creating an
- -- Ada task with no explicit Storize_Size clause.
+ -- Default_Stack_Size is the default stack size used when creating an Ada
+ -- task with no explicit Storize_Size clause.
-- Leap_Seconds_Support denotes whether leap seconds have been enabled or
-- disabled. A value of zero indicates that leap seconds are turned "off",
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index aea61397dc9..f55bd7cec75 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -470,7 +470,11 @@ package body Checks is
-- Apply_Accessibility_Check --
-------------------------------
- procedure Apply_Accessibility_Check (N : Node_Id; Typ : Entity_Id) is
+ procedure Apply_Accessibility_Check
+ (N : Node_Id;
+ Typ : Entity_Id;
+ Insert_Node : Node_Id)
+ is
Loc : constant Source_Ptr := Sloc (N);
Param_Ent : constant Entity_Id := Param_Entity (N);
Param_Level : Node_Id;
@@ -501,7 +505,7 @@ package body Checks is
-- Raise Program_Error if the accessibility level of the the access
-- parameter is deeper than the level of the target access type.
- Insert_Action (N,
+ Insert_Action (Insert_Node,
Make_Raise_Program_Error (Loc,
Condition =>
Make_Op_Gt (Loc,
@@ -1629,11 +1633,36 @@ package body Checks is
end;
end if;
- -- Get the bounds of the target type
+ -- Get the (static) bounds of the target type
Ifirst := Expr_Value (LB);
Ilast := Expr_Value (HB);
+ -- A simple optimization: if the expression is a universal literal,
+ -- we can do the comparison with the bounds and the conversion to
+ -- an integer type statically. The range checks are unchanged.
+
+ if Nkind (Ck_Node) = N_Real_Literal
+ and then Etype (Ck_Node) = Universal_Real
+ and then Is_Integer_Type (Target_Typ)
+ and then Nkind (Parent (Ck_Node)) = N_Type_Conversion
+ then
+ declare
+ Int_Val : constant Uint := UR_To_Uint (Realval (Ck_Node));
+
+ begin
+ if Int_Val <= Ilast and then Int_Val >= Ifirst then
+
+ -- Conversion is safe.
+
+ Rewrite (Parent (Ck_Node),
+ Make_Integer_Literal (Loc, UI_To_Int (Int_Val)));
+ Analyze_And_Resolve (Parent (Ck_Node), Target_Typ);
+ return;
+ end if;
+ end;
+ end if;
+
-- Check against lower bound
if Truncate and then Ifirst > 0 then
diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads
index 0c9049471b4..7b231473c81 100644
--- a/gcc/ada/checks.ads
+++ b/gcc/ada/checks.ads
@@ -102,11 +102,15 @@ package Checks is
-- Determines whether an expression node requires a runtime access
-- check and if so inserts the appropriate run-time check.
- procedure Apply_Accessibility_Check (N : Node_Id; Typ : Entity_Id);
+ procedure Apply_Accessibility_Check
+ (N : Node_Id;
+ Typ : Entity_Id;
+ Insert_Node : Node_Id);
-- Given a name N denoting an access parameter, emits a run-time
-- accessibility check (if necessary), checking that the level of
-- the object denoted by the access parameter is not deeper than the
-- level of the type Typ. Program_Error is raised if the check fails.
+ -- Insert_Node indicates the node where the check should be inserted.
procedure Apply_Address_Clause_Check (E : Entity_Id; N : Node_Id);
-- E is the entity for an object which has an address clause. If checks
diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb
index 5db4c4efc67..30aa9a45c41 100644
--- a/gcc/ada/clean.adb
+++ b/gcc/ada/clean.adb
@@ -826,9 +826,6 @@ package body Clean is
Index2 : Int;
Lib_File : File_Name_Type;
- Source_Id : Other_Source_Id;
- Source : Other_Source;
-
Global_Archive : Boolean := False;
begin
@@ -881,7 +878,7 @@ package body Clean is
-- Source_Dirs or Source_Files is specified as an empty list,
-- so always look for Ada units in extending projects.
- if Data.Langs (Ada_Language_Index)
+ if Data.Ada_Sources_Present
or else Data.Extends /= No_Project
then
for Unit in Unit_Table.First ..
@@ -1044,40 +1041,6 @@ package body Clean is
end if;
end if;
- if Data.Other_Sources_Present then
-
- -- There is non-Ada code: delete the object files and
- -- the dependency files if they exist.
-
- Source_Id := Data.First_Other_Source;
- while Source_Id /= No_Other_Source loop
- Source :=
- Project_Tree.Other_Sources.Table (Source_Id);
-
- if Is_Regular_File
- (Get_Name_String (Source.Object_Name))
- then
- Delete (Obj_Dir, Get_Name_String (Source.Object_Name));
- end if;
-
- if
- Is_Regular_File (Get_Name_String (Source.Dep_Name))
- then
- Delete (Obj_Dir, Get_Name_String (Source.Dep_Name));
- end if;
-
- Source_Id := Source.Next;
- end loop;
-
- -- If it is a library with only non Ada sources, delete
- -- the fake archive and the dependency file, if they exist.
-
- if Data.Library
- and then not Data.Langs (Ada_Language_Index)
- then
- Clean_Archive (Project, Global => False);
- end if;
- end if;
end;
end if;
diff --git a/gcc/ada/cstreams.c b/gcc/ada/cstreams.c
index fe81bcbe97e..79dde9331c0 100644
--- a/gcc/ada/cstreams.c
+++ b/gcc/ada/cstreams.c
@@ -6,7 +6,7 @@
* *
* Auxiliary C functions for Interfaces.C.Streams *
* *
- * Copyright (C) 1992-2007, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2008, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
@@ -156,7 +156,18 @@ __gnat_constant_stdout (void)
char *
__gnat_full_name (char *nam, char *buffer)
{
-#if defined(__EMX__) || defined (__MINGW32__)
+#ifdef RTSS
+ /* RTSS applications have no current-directory notion, so RTSS file I/O
+ requests must use fully qualified path names, such as:
+ c:\temp\MyFile.txt (for a file system object)
+ \\.\MyDevice0 (for a device object)
+ */
+ if (nam[1] == ':' || nam[0] == '\\')
+ strcpy (buffer, nam);
+ else
+ buffer[0] = '\0';
+
+#elif defined(__EMX__) || defined (__MINGW32__)
/* If this is a device file return it as is; under Windows NT and
OS/2 a device file end with ":". */
if (nam[strlen (nam) - 1] == ':')
diff --git a/gcc/ada/directio.ads b/gcc/ada/directio.ads
index b69ca4467e1..c09f77270b9 100644
--- a/gcc/ada/directio.ads
+++ b/gcc/ada/directio.ads
@@ -15,9 +15,9 @@
pragma Ada_2005;
-- Explicit setting of Ada 2005 mode is required here, since we want to with a
--- child unit (not possible in Ada 83 mode), and Text_IO is not considered to
--- be an internal unit that is automatically compiled in Ada 2005 mode (since
--- a user is allowed to redeclare Direct_IO).
+-- child unit (not possible in Ada 83 mode), and Direct_IO is not considered
+-- to be an internal unit that is automatically compiled in Ada 2005 mode
+-- (since a user is allowed to redeclare Direct_IO).
with Ada.Direct_IO;
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 01d384ec4f6..255b7a0cdcc 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -2579,7 +2579,7 @@ package body Einfo is
function Spec_PPC_List (Id : E) return N is
begin
- pragma Assert (Is_Subprogram (Id));
+ pragma Assert (Is_Subprogram (Id) or else Is_Generic_Subprogram (Id));
return Node24 (Id);
end Spec_PPC_List;
@@ -5044,7 +5044,7 @@ package body Einfo is
procedure Set_Spec_PPC_List (Id : E; V : N) is
begin
- pragma Assert (Is_Subprogram (Id));
+ pragma Assert (Is_Subprogram (Id) or else Is_Generic_Subprogram (Id));
Set_Node24 (Id, V);
end Set_Spec_PPC_List;
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 8316a68018a..c7182dbe04f 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -3527,10 +3527,11 @@ package Einfo is
-- the corresponding parameter entities in the spec.
-- Spec_PPC_List (Node24)
--- Present in subprogram entities. Points to a list of Precondition
--- and Postcondition N_Pragma nodes for preconditions and postconditions
--- declared in the spec. The last pragma encountered is at the head of
--- this list, so it is in reverse order of textual appearance.
+-- Present in subprogram and generic subprogram entities. Points to a
+-- list of Precondition and Postcondition pragma nodes for preconditions
+-- and postconditions declared in the spec. The last pragma encountered
+-- is at the head of this list, so it is in reverse order of textual
+-- appearance.
-- Storage_Size_Variable (Node15) [implementation base type only]
-- Present in access types and task type entities. This flag is set
@@ -5277,7 +5278,7 @@ package Einfo is
-- Generic_Renamings (Elist23) (for instance)
-- Inner_Instances (Elist23) (for generic proc)
-- Protection_Object (Node23) (for concurrent kind)
- -- Spec_PPC_List (Node24) (non-generic case only)
+ -- Spec_PPC_List (Node24)
-- Interface_Alias (Node25)
-- Static_Initialization (Node26) (init_proc only)
-- Overridden_Operation (Node26)
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 40ff3796671..eaff8e89a9e 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -28,6 +28,7 @@ with Checks; use Checks;
with Debug; use Debug;
with Einfo; use Einfo;
with Elists; use Elists;
+with Errout; use Errout;
with Expander; use Expander;
with Exp_Util; use Exp_Util;
with Exp_Ch3; use Exp_Ch3;
@@ -169,12 +170,15 @@ package body Exp_Aggr is
-- Local Subprograms for Array Aggregate Expansion --
-----------------------------------------------------
- function Aggr_Size_OK (Typ : Entity_Id) return Boolean;
+ function Aggr_Size_OK (N : Node_Id; Typ : Entity_Id) return Boolean;
-- Very large static aggregates present problems to the back-end, and
-- are transformed into assignments and loops. This function verifies
-- that the total number of components of an aggregate is acceptable
-- for transformation into a purely positional static form. It is called
-- prior to calling Flatten.
+ -- This function also detects and warns about one-component aggregates
+ -- that appear in a non-static context. Even if the component value is
+ -- static, such an aggregate must be expanded into an assignment.
procedure Convert_Array_Aggr_In_Allocator
(Decl : Node_Id;
@@ -291,7 +295,7 @@ package body Exp_Aggr is
-- Aggr_Size_OK --
------------------
- function Aggr_Size_OK (Typ : Entity_Id) return Boolean is
+ function Aggr_Size_OK (N : Node_Id; Typ : Entity_Id) return Boolean is
Lo : Node_Id;
Hi : Node_Id;
Indx : Node_Id;
@@ -399,6 +403,43 @@ package body Exp_Aggr is
return True;
end if;
+ -- One-component aggregates are suspicious, and if the context type
+ -- is an object declaration with non-static bounds it will trip gcc;
+ -- such an aggregate must be expanded into a single assignment.
+
+ if Hiv = Lov
+ and then Nkind (Parent (N)) = N_Object_Declaration
+ then
+ declare
+ Index_Type : constant Entity_Id :=
+ Etype
+ (First_Index
+ (Etype (Defining_Identifier (Parent (N)))));
+ Indx : Node_Id;
+
+ begin
+ if not Compile_Time_Known_Value (Type_Low_Bound (Index_Type))
+ or else not Compile_Time_Known_Value
+ (Type_High_Bound (Index_Type))
+ then
+ if Present (Component_Associations (N)) then
+ Indx :=
+ First (Choices (First (Component_Associations (N))));
+ if Is_Entity_Name (Indx)
+ and then not Is_Type (Entity (Indx))
+ then
+ Error_Msg_N
+ ("single component aggregate in non-static context?",
+ Indx);
+ Error_Msg_N ("\maybe subtype name was meant?", Indx);
+ end if;
+ end if;
+
+ return False;
+ end if;
+ end;
+ end if;
+
declare
Rng : constant Uint := Hiv - Lov + 1;
@@ -3847,7 +3888,7 @@ package body Exp_Aggr is
-- assignments to the target anyway, but it is conceivable that
-- it will eventually be able to treat such aggregates statically???
- if Aggr_Size_OK (Typ)
+ if Aggr_Size_OK (N, Typ)
and then Flatten (N, First_Index (Typ), First_Index (Base_Type (Typ)))
then
if Static_Components then
@@ -6383,7 +6424,7 @@ package body Exp_Aggr is
elsif Nkind (Expression (Expr)) /= N_Integer_Literal then
return False;
- elsif not Aggr_Size_OK (Typ) then
+ elsif not Aggr_Size_OK (N, Typ) then
return False;
end if;
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 1637863cf45..8e0a83b5d43 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -651,6 +651,37 @@ package body Exp_Attr is
Btyp_DDT : constant Entity_Id := Directly_Designated_Type (Btyp);
Ref_Object : constant Node_Id := Get_Referenced_Object (Pref);
+ function Enclosing_Object (N : Node_Id) return Node_Id;
+ -- If N denotes a compound name (selected component, indexed
+ -- component, or slice), returns the name of the outermost
+ -- such enclosing object. Otherwise returns N. If the object
+ -- is a renaming, then the renamed object is returned.
+
+ ----------------------
+ -- Enclosing_Object --
+ ----------------------
+
+ function Enclosing_Object (N : Node_Id) return Node_Id is
+ Obj_Name : Node_Id;
+
+ begin
+ Obj_Name := N;
+ while Nkind_In (Obj_Name, N_Selected_Component,
+ N_Indexed_Component,
+ N_Slice)
+ loop
+ Obj_Name := Prefix (Obj_Name);
+ end loop;
+
+ return Get_Referenced_Object (Obj_Name);
+ end Enclosing_Object;
+
+ -- Local declarations
+
+ Enc_Object : constant Node_Id := Enclosing_Object (Ref_Object);
+
+ -- Start of processing for Access_Cases
+
begin
-- In order to improve the text of error messages, the designated
-- type of access-to-subprogram itypes is set by the semantics as
@@ -800,35 +831,31 @@ package body Exp_Attr is
end;
-- If the prefix of an Access attribute is a dereference of an
- -- access parameter (or a renaming of such a dereference) and
- -- the context is a general access type (but not an anonymous
- -- access type), then rewrite the attribute as a conversion of
- -- the access parameter to the context access type. This will
- -- result in an accessibility check being performed, if needed.
-
- -- (X.all'Access => Acc_Type (X))
-
- -- Note: Limit the expansion of an attribute applied to a
- -- dereference of an access parameter so that it's only done
- -- for 'Access. This fixes a problem with 'Unrestricted_Access
- -- that leads to errors in the case where the attribute type
- -- is access-to-variable and the access parameter is
- -- access-to-constant. The conversion is only done to get
- -- accessibility checks, so it makes sense to limit it to
- -- 'Access.
-
- elsif Nkind (Ref_Object) = N_Explicit_Dereference
- and then Is_Entity_Name (Prefix (Ref_Object))
+ -- access parameter (or a renaming of such a dereference, or a
+ -- subcomponent of such a dereference) and the context is a
+ -- general access type (but not an anonymous access type), then
+ -- apply an accessibility check to the access parameter. We used
+ -- to rewrite the access parameter as a type conversion, but that
+ -- could only be done if the immediate prefix of the Access
+ -- attribute was the dereference, and didn't handle cases where
+ -- the attribute is applied to a subcomponent of the dereference,
+ -- since there's generally no available, appropriate access type
+ -- to convert to in that case. The attribute is passed as the
+ -- point to insert the check, because the access parameter may
+ -- come from a renaming, possibly in a different scope, and the
+ -- check must be associated with the attribute itself.
+
+ elsif Id = Attribute_Access
+ and then Nkind (Enc_Object) = N_Explicit_Dereference
+ and then Is_Entity_Name (Prefix (Enc_Object))
and then Ekind (Btyp) = E_General_Access_Type
- and then Ekind (Entity (Prefix (Ref_Object))) in Formal_Kind
- and then Ekind (Etype (Entity (Prefix (Ref_Object))))
+ and then Ekind (Entity (Prefix (Enc_Object))) in Formal_Kind
+ and then Ekind (Etype (Entity (Prefix (Enc_Object))))
= E_Anonymous_Access_Type
and then Present (Extra_Accessibility
- (Entity (Prefix (Ref_Object))))
+ (Entity (Prefix (Enc_Object))))
then
- Rewrite (N,
- Convert_To (Typ, New_Copy_Tree (Prefix (Ref_Object))));
- Analyze_And_Resolve (N, Typ);
+ Apply_Accessibility_Check (Prefix (Enc_Object), Typ, N);
-- Ada 2005 (AI-251): If the designated type is an interface we
-- add an implicit conversion to force the displacement of the
@@ -5314,7 +5341,8 @@ package body Exp_Attr is
(Typ : Entity_Id;
Nam : TSS_Name_Type) return Entity_Id
is
- Ent : constant Entity_Id := TSS (Typ, Nam);
+ Base_Typ : constant Entity_Id := Base_Type (Typ);
+ Ent : constant Entity_Id := TSS (Typ, Nam);
begin
if Present (Ent) then
@@ -5337,53 +5365,100 @@ package body Exp_Attr is
and then
not Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit))
then
-
-- String as defined in package Ada
- if Typ = Standard_String then
- if Nam = TSS_Stream_Input then
- return RTE (RE_String_Input);
+ if Base_Typ = Standard_String then
+ if Restriction_Active (No_Stream_Optimizations) then
+ if Nam = TSS_Stream_Input then
+ return RTE (RE_String_Input);
- elsif Nam = TSS_Stream_Output then
- return RTE (RE_String_Output);
+ elsif Nam = TSS_Stream_Output then
+ return RTE (RE_String_Output);
- elsif Nam = TSS_Stream_Read then
- return RTE (RE_String_Read);
+ elsif Nam = TSS_Stream_Read then
+ return RTE (RE_String_Read);
+
+ else pragma Assert (Nam = TSS_Stream_Write);
+ return RTE (RE_String_Write);
+ end if;
+
+ else
+ if Nam = TSS_Stream_Input then
+ return RTE (RE_String_Input_Blk_IO);
- else pragma Assert (Nam = TSS_Stream_Write);
- return RTE (RE_String_Write);
+ elsif Nam = TSS_Stream_Output then
+ return RTE (RE_String_Output_Blk_IO);
+
+ elsif Nam = TSS_Stream_Read then
+ return RTE (RE_String_Read_Blk_IO);
+
+ else pragma Assert (Nam = TSS_Stream_Write);
+ return RTE (RE_String_Write_Blk_IO);
+ end if;
end if;
-- Wide_String as defined in package Ada
- elsif Typ = Standard_Wide_String then
- if Nam = TSS_Stream_Input then
- return RTE (RE_Wide_String_Input);
+ elsif Base_Typ = Standard_Wide_String then
+ if Restriction_Active (No_Stream_Optimizations) then
+ if Nam = TSS_Stream_Input then
+ return RTE (RE_Wide_String_Input);
+
+ elsif Nam = TSS_Stream_Output then
+ return RTE (RE_Wide_String_Output);
+
+ elsif Nam = TSS_Stream_Read then
+ return RTE (RE_Wide_String_Read);
+
+ else pragma Assert (Nam = TSS_Stream_Write);
+ return RTE (RE_Wide_String_Write);
+ end if;
+
+ else
+ if Nam = TSS_Stream_Input then
+ return RTE (RE_Wide_String_Input_Blk_IO);
- elsif Nam = TSS_Stream_Output then
- return RTE (RE_Wide_String_Output);
+ elsif Nam = TSS_Stream_Output then
+ return RTE (RE_Wide_String_Output_Blk_IO);
- elsif Nam = TSS_Stream_Read then
- return RTE (RE_Wide_String_Read);
+ elsif Nam = TSS_Stream_Read then
+ return RTE (RE_Wide_String_Read_Blk_IO);
- else pragma Assert (Nam = TSS_Stream_Write);
- return RTE (RE_Wide_String_Write);
+ else pragma Assert (Nam = TSS_Stream_Write);
+ return RTE (RE_Wide_String_Write_Blk_IO);
+ end if;
end if;
-- Wide_Wide_String as defined in package Ada
- elsif Typ = Standard_Wide_Wide_String then
- if Nam = TSS_Stream_Input then
- return RTE (RE_Wide_Wide_String_Input);
+ elsif Base_Typ = Standard_Wide_Wide_String then
+ if Restriction_Active (No_Stream_Optimizations) then
+ if Nam = TSS_Stream_Input then
+ return RTE (RE_Wide_Wide_String_Input);
+
+ elsif Nam = TSS_Stream_Output then
+ return RTE (RE_Wide_Wide_String_Output);
+
+ elsif Nam = TSS_Stream_Read then
+ return RTE (RE_Wide_Wide_String_Read);
+
+ else pragma Assert (Nam = TSS_Stream_Write);
+ return RTE (RE_Wide_Wide_String_Write);
+ end if;
+
+ else
+ if Nam = TSS_Stream_Input then
+ return RTE (RE_Wide_Wide_String_Input_Blk_IO);
- elsif Nam = TSS_Stream_Output then
- return RTE (RE_Wide_Wide_String_Output);
+ elsif Nam = TSS_Stream_Output then
+ return RTE (RE_Wide_Wide_String_Output_Blk_IO);
- elsif Nam = TSS_Stream_Read then
- return RTE (RE_Wide_Wide_String_Read);
+ elsif Nam = TSS_Stream_Read then
+ return RTE (RE_Wide_Wide_String_Read_Blk_IO);
- else pragma Assert (Nam = TSS_Stream_Write);
- return RTE (RE_Wide_Wide_String_Write);
+ else pragma Assert (Nam = TSS_Stream_Write);
+ return RTE (RE_Wide_Wide_String_Write_Blk_IO);
+ end if;
end if;
end if;
end if;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 798da67036e..ba09aa69807 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -3440,7 +3440,8 @@ package body Exp_Ch4 is
and then
Ekind (Etype (Nod)) = E_Anonymous_Access_Type
then
- Apply_Accessibility_Check (Nod, Typ);
+ Apply_Accessibility_Check
+ (Nod, Typ, Insert_Node => Nod);
end if;
Next_Elmt (Discr);
@@ -7552,9 +7553,9 @@ package body Exp_Ch4 is
-- Apply an accessibility check when the conversion operand is an
-- access parameter (or a renaming thereof), unless conversion was
- -- expanded from an unchecked or unrestricted access attribute. Note
- -- that other checks may still need to be applied below (such as
- -- tagged type checks).
+ -- expanded from an Unchecked_ or Unrestricted_Access attribute.
+ -- Note that other checks may still need to be applied below (such
+ -- as tagged type checks).
if Is_Entity_Name (Operand)
and then
@@ -7568,9 +7569,10 @@ package body Exp_Ch4 is
and then (Nkind (Original_Node (N)) /= N_Attribute_Reference
or else Attribute_Name (Original_Node (N)) = Name_Access)
then
- Apply_Accessibility_Check (Operand, Target_Type);
+ Apply_Accessibility_Check
+ (Operand, Target_Type, Insert_Node => Operand);
- -- If the level of the operand type is statically deeper then the
+ -- If the level of the operand type is statically deeper than the
-- level of the target type, then force Program_Error. Note that this
-- can only occur for cases where the attribute is within the body of
-- an instantiation (otherwise the conversion will already have been
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index cddc0210241..2d31162a049 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -1,4 +1,4 @@
------------------------------------------------------------------------------
+------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
@@ -2034,15 +2034,6 @@ package body Exp_Ch6 is
Prev := Actual;
Prev_Orig := Original_Node (Prev);
- -- The original actual may have been a call written in prefix
- -- form, and rewritten before analysis.
-
- if not Analyzed (Prev_Orig)
- and then Nkind_In (Actual, N_Function_Call, N_Identifier)
- then
- Prev_Orig := Prev;
- end if;
-
-- Ada 2005 (AI-251): Check if any formal is a class-wide interface
-- to expand it in a further round.
@@ -2070,16 +2061,16 @@ package body Exp_Ch6 is
if Ekind (Etype (Prev)) in Private_Kind
and then not Has_Discriminants (Base_Type (Etype (Prev)))
then
- Add_Extra_Actual (
- New_Occurrence_Of (Standard_False, Loc),
- Extra_Constrained (Formal));
+ Add_Extra_Actual
+ (New_Occurrence_Of (Standard_False, Loc),
+ Extra_Constrained (Formal));
elsif Is_Constrained (Etype (Formal))
or else not Has_Discriminants (Etype (Prev))
then
- Add_Extra_Actual (
- New_Occurrence_Of (Standard_True, Loc),
- Extra_Constrained (Formal));
+ Add_Extra_Actual
+ (New_Occurrence_Of (Standard_True, Loc),
+ Extra_Constrained (Formal));
-- Do not produce extra actuals for Unchecked_Union parameters.
-- Jump directly to the end of the loop.
@@ -2220,7 +2211,7 @@ package body Exp_Ch6 is
else
Add_Extra_Actual
(Make_Integer_Literal (Loc,
- Intval => Scope_Depth (Standard_Standard)),
+ Intval => Scope_Depth (Standard_Standard)),
Extra_Accessibility (Formal));
end if;
end;
@@ -2231,11 +2222,25 @@ package body Exp_Ch6 is
else
Add_Extra_Actual
(Make_Integer_Literal (Loc,
- Intval => Type_Access_Level (Etype (Prev_Orig))),
+ Intval => Type_Access_Level (Etype (Prev_Orig))),
Extra_Accessibility (Formal));
end if;
- -- All cases other than thunks
+ -- If the actual is an access discriminant, then pass the level
+ -- of the enclosing object (RM05-3.10.2(12.4/2)).
+
+ elsif Nkind (Prev_Orig) = N_Selected_Component
+ and then Ekind (Entity (Selector_Name (Prev_Orig))) =
+ E_Discriminant
+ and then Ekind (Etype (Entity (Selector_Name (Prev_Orig)))) =
+ E_Anonymous_Access_Type
+ then
+ Add_Extra_Actual
+ (Make_Integer_Literal (Loc,
+ Intval => Object_Access_Level (Prefix (Prev_Orig))),
+ Extra_Accessibility (Formal));
+
+ -- All other cases
else
case Nkind (Prev_Orig) is
@@ -2246,20 +2251,20 @@ package body Exp_Ch6 is
-- For X'Access, pass on the level of the prefix X
when Attribute_Access =>
- Add_Extra_Actual (
- Make_Integer_Literal (Loc,
- Intval =>
- Object_Access_Level (Prefix (Prev_Orig))),
- Extra_Accessibility (Formal));
+ Add_Extra_Actual
+ (Make_Integer_Literal (Loc,
+ Intval =>
+ Object_Access_Level (Prefix (Prev_Orig))),
+ Extra_Accessibility (Formal));
-- Treat the unchecked attributes as library-level
when Attribute_Unchecked_Access |
Attribute_Unrestricted_Access =>
- Add_Extra_Actual (
- Make_Integer_Literal (Loc,
- Intval => Scope_Depth (Standard_Standard)),
- Extra_Accessibility (Formal));
+ Add_Extra_Actual
+ (Make_Integer_Literal (Loc,
+ Intval => Scope_Depth (Standard_Standard)),
+ Extra_Accessibility (Formal));
-- No other cases of attributes returning access
-- values that can be passed to access parameters
@@ -2274,19 +2279,21 @@ package body Exp_Ch6 is
-- current scope level.
when N_Allocator =>
- Add_Extra_Actual (
- Make_Integer_Literal (Loc,
- Scope_Depth (Current_Scope) + 1),
- Extra_Accessibility (Formal));
+ Add_Extra_Actual
+ (Make_Integer_Literal (Loc,
+ Intval => Scope_Depth (Current_Scope) + 1),
+ Extra_Accessibility (Formal));
- -- For other cases we simply pass the level of the
- -- actual's access type.
+ -- For other cases we simply pass the level of the actual's
+ -- access type. The type is retrieved from Prev rather than
+ -- Prev_Orig, because in some cases Prev_Orig denotes a
+ -- original expression that has not been analyzed.
when others =>
- Add_Extra_Actual (
- Make_Integer_Literal (Loc,
- Intval => Type_Access_Level (Etype (Prev_Orig))),
- Extra_Accessibility (Formal));
+ Add_Extra_Actual
+ (Make_Integer_Literal (Loc,
+ Intval => Type_Access_Level (Etype (Prev))),
+ Extra_Accessibility (Formal));
end case;
end if;
@@ -5496,7 +5503,7 @@ package body Exp_Ch6 is
if Is_Constrained (Underlying_Type (Result_Subt)) then
Insert_After_And_Analyze (Object_Decl, Ptr_Typ_Decl);
else
- Insert_Before_And_Analyze (Object_Decl, Ptr_Typ_Decl);
+ Insert_Action (Object_Decl, Ptr_Typ_Decl);
end if;
-- Finally, create an access object initialized to a reference to the
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 574d01f0ac8..2a91413d570 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -1634,7 +1634,7 @@ package body Exp_Ch9 is
-- when a protected entry wrapper must override an interface
-- level procedure with interface access as first parameter.
- -- O.all.Subp_Id (Formal_1 .. Formal_N)
+ -- O.all.Subp_Id (Formal_1, ..., Formal_N)
if Nkind (Parameter_Type (First_Formal)) =
N_Access_Definition
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 864206951f6..461edc75a3d 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -766,6 +766,13 @@ package body Exp_Disp is
Iface_Typ := Root_Type (Iface_Typ);
end if;
+ -- If the target type is a tagged synchronized type, the dispatch table
+ -- info is in the correspondoing record type.
+
+ if Is_Concurrent_Type (Iface_Typ) then
+ Iface_Typ := Corresponding_Record_Type (Iface_Typ);
+ end if;
+
pragma Assert (not Is_Static
or else (not Is_Class_Wide_Type (Iface_Typ)
and then Is_Interface (Iface_Typ)));
@@ -6042,6 +6049,13 @@ package body Exp_Disp is
Full_Typ := Corresponding_Concurrent_Type (Typ);
end if;
+ -- When a private tagged type is completed by a concurrent type,
+ -- retrieve the full view.
+
+ if Is_Private_Type (Full_Typ) then
+ Full_Typ := Full_View (Full_Typ);
+ end if;
+
if Ekind (Prim_Op) = E_Function then
-- Protected function
diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h
index 2e21af503de..e69f798db5d 100644
--- a/gcc/ada/fe.h
+++ b/gcc/ada/fe.h
@@ -219,8 +219,10 @@ extern void Set_Has_No_Elaboration_Code (Node_Id, Boolean);
/* targparm: */
+#define Backend_Overflow_Checks_On_Target targparm__backend_overflow_checks_on_target
#define Stack_Check_Probes_On_Target targparm__stack_check_probes_on_target
#define Stack_Check_Limits_On_Target targparm__stack_check_limits_on_target
+extern Boolean Backend_Overflow_Checks_On_Target;
extern Boolean Stack_Check_Probes_On_Target;
extern Boolean Stack_Check_Limits_On_Target;
diff --git a/gcc/ada/g-pehage.adb b/gcc/ada/g-pehage.adb
index c779fac7ca7..129cecc7659 100644
--- a/gcc/ada/g-pehage.adb
+++ b/gcc/ada/g-pehage.adb
@@ -49,8 +49,8 @@ package body GNAT.Perfect_Hash_Generators is
-- h (w) = (g (f1 (w)) + g (f2 (w))) mod m
- -- where f1 and f2 are functions that map strings into integers, and g is a
- -- function that maps integers into [0, m-1]. h can be order preserving.
+ -- where f1 and f2 are functions that map strings into integers, and g is
+ -- a function that maps integers into [0, m-1]. h can be order preserving.
-- For instance, let W = {w_0, ..., w_i, ..., w_m-1}, h can be defined
-- such that h (w_i) = i.
@@ -132,10 +132,10 @@ package body GNAT.Perfect_Hash_Generators is
package WT is new GNAT.Table (Word_Type, Word_Id, 0, 32, 32);
package IT is new GNAT.Table (Integer, Integer, 0, 32, 32);
-- The two main tables. WT is used to store the words in their initial
- -- version and in their reduced version (that is words reduced to
- -- their significant characters). As an instance of GNAT.Table, WT does
- -- not initialize string pointers to null. This initialization has to be
- -- done manually when the table is allocated. IT is used to store several
+ -- version and in their reduced version (that is words reduced to their
+ -- significant characters). As an instance of GNAT.Table, WT does not
+ -- initialize string pointers to null. This initialization has to be done
+ -- manually when the table is allocated. IT is used to store several
-- tables of components containing only integers.
function Image (Int : Integer; W : Natural := 0) return String;
@@ -591,7 +591,7 @@ package body GNAT.Perfect_Hash_Generators is
-- Start of processing for Assign_Values_To_Vertices
begin
- -- Value -1 denotes an unitialized value as it is supposed to
+ -- Value -1 denotes an uninitialized value as it is supposed to
-- be in the range 0 .. NK.
if G = No_Table then
@@ -1141,11 +1141,10 @@ package body GNAT.Perfect_Hash_Generators is
Tries : Positive := Default_Tries)
is
begin
- -- Deallocated the part of the table concerning the reduced
- -- words. Initial words are already present in the table. We
- -- may have reduced words already there because a previous
- -- computation failed. We are currently retrying and the
- -- reduced words have to be deallocated.
+ -- Deallocate the part of the table concerning the reduced words.
+ -- Initial words are already present in the table. We may have reduced
+ -- words already there because a previous computation failed. We are
+ -- currently retrying and the reduced words have to be deallocated.
for W in NK .. WT.Last loop
Free_Word (WT.Table (W));
diff --git a/gcc/ada/g-pehage.ads b/gcc/ada/g-pehage.ads
index 277a2a4580b..8b75f2e8803 100644
--- a/gcc/ada/g-pehage.ads
+++ b/gcc/ada/g-pehage.ads
@@ -99,18 +99,18 @@ package GNAT.Perfect_Hash_Generators is
K_To_V : Float := Default_K_To_V;
Optim : Optimization := CPU_Time;
Tries : Positive := Default_Tries);
- -- Initialize the generator and its internal structures. Set the
- -- ratio of vertices over keys in the random graphs. This value
- -- has to be greater than 2.0 in order for the algorithm to
- -- succeed. The word set is not modified (in particular when it is
- -- already set). For instance, it is possible to run several times
- -- the generator with different settings on the same words.
-
- -- A classical way of doing is to Insert all the words and then to
- -- invoke Initialize and Compute. If Compute fails to find a
- -- perfect hash function, invoke Initialize another time with
- -- other configuration parameters (probably with a greater K_To_V
- -- ratio). Once successful, invoke Produce and Finalize.
+ -- Initialize the generator and its internal structures. Set the ratio of
+ -- vertices over keys in the random graphs. This value has to be greater
+ -- than 2.0 in order for the algorithm to succeed. The word set is not
+ -- modified (in particular when it is already set). For instance, it is
+ -- possible to run several times the generator with different settings on
+ -- the same words.
+ --
+ -- A classical way of doing is to Insert all the words and then to invoke
+ -- Initialize and Compute. If Compute fails to find a perfect hash
+ -- function, invoke Initialize another time with other configuration
+ -- parameters (probably with a greater K_To_V ratio). Once successful,
+ -- invoke Produce and Finalize.
procedure Finalize;
-- Deallocate the internal structures and the words table
@@ -219,8 +219,8 @@ package GNAT.Perfect_Hash_Generators is
Length_2 : out Natural);
-- Return the definition of the table Name. This includes the length of
-- dimensions 1 and 2 and the size of an unsigned integer item. When
- -- Length_2 is zero, the table has only one dimension. All the ranges start
- -- from zero.
+ -- Length_2 is zero, the table has only one dimension. All the ranges
+ -- start from zero.
function Value
(Name : Table_Name;
diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in
index a8c0c1bbb25..acc523d8abb 100644
--- a/gcc/ada/gcc-interface/Makefile.in
+++ b/gcc/ada/gcc-interface/Makefile.in
@@ -1335,7 +1335,9 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),)
EH_MECHANISM=-gcc
else
- LIBGNAT_TARGET_PAIRS += system.ads<system-rtx-rtss.ads
+ LIBGNAT_TARGET_PAIRS += \
+ system.ads<system-rtx-rtss.ads \
+ s-parame.adb<s-parame-vxworks.adb
EH_MECHANISM=
endif
@@ -1353,7 +1355,7 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),)
s-taprop.adb<s-taprop-mingw.adb \
system.ads<system-mingw.ads
- EXTRA_GNATRTL_NONTASKING_OBJS = s-win32.o g-regist.o
+ EXTRA_GNATRTL_NONTASKING_OBJS = s-win32.o s-winext.o g-regist.o
EXTRA_GNATRTL_TASKING_OBJS = a-exetim.o
MISCLIB = -lwsock32
@@ -1715,13 +1717,13 @@ endif
# go into the directory. The pthreads emulation is built in the threads
# subdirectory and copied.
LIBGNAT_SRCS = adaint.c adaint.h argv.c cio.c cstreams.c \
- errno.c exit.c cal.c ctrl_c.c env.c env.h \
+ errno.c exit.c cal.c ctrl_c.c env.c env.h arit64.c \
raise.h raise.c sysdep.c aux-io.c init.c initialize.c seh_init.c \
final.c tracebak.c tb-alvms.c tb-alvxw.c tb-gcc.c expect.c mkdir.c \
socket.c gsocket.h targext.c $(EXTRA_LIBGNAT_SRCS)
LIBGNAT_OBJS = adaint.o argv.o cio.o cstreams.o ctrl_c.o errno.o exit.o env.o \
- raise.o sysdep.o aux-io.o init.o initialize.o seh_init.o cal.o \
+ raise.o sysdep.o aux-io.o init.o initialize.o seh_init.o cal.o arit64.o \
final.o tracebak.o expect.o mkdir.o socket.o targext.o $(EXTRA_LIBGNAT_OBJS)
# NOTE ??? - when the -I option for compiling Ada code is made to work,
diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h
index 9472995effc..1db5ce28ecf 100644
--- a/gcc/ada/gcc-interface/ada-tree.h
+++ b/gcc/ada/gcc-interface/ada-tree.h
@@ -294,10 +294,10 @@ struct lang_type GTY(()) {tree t; };
#define SET_DECL_FUNCTION_STUB(NODE, X) \
SET_DECL_LANG_SPECIFIC (FUNCTION_DECL_CHECK (NODE), X)
-/* In a PARM_DECL, points to the alternate TREE_TYPE */
-#define DECL_PARM_ALT(NODE) \
+/* In a PARM_DECL, points to the alternate TREE_TYPE. */
+#define DECL_PARM_ALT_TYPE(NODE) \
GET_DECL_LANG_SPECIFIC (PARM_DECL_CHECK (NODE))
-#define SET_DECL_PARM_ALT(NODE, X) \
+#define SET_DECL_PARM_ALT_TYPE(NODE, X) \
SET_DECL_LANG_SPECIFIC (PARM_DECL_CHECK (NODE), X)
/* In a FIELD_DECL corresponding to a discriminant, contains the
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 61ae653de2a..c9e90457803 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -367,12 +367,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
switch (kind)
{
case E_Constant:
- /* If this is a use of a deferred constant, get its full
- declaration. */
- if (!definition && Present (Full_View (gnat_entity)))
+ /* If this is a use of a deferred constant without address clause,
+ get its full definition. */
+ if (!definition
+ && No (Address_Clause (gnat_entity))
+ && Present (Full_View (gnat_entity)))
{
- gnu_decl = gnat_to_gnu_entity (Full_View (gnat_entity),
- gnu_expr, 0);
+ gnu_decl
+ = gnat_to_gnu_entity (Full_View (gnat_entity), gnu_expr, 0);
saved = true;
break;
}
@@ -391,12 +393,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
!= N_Allocator))
gnu_expr = gnat_to_gnu (Expression (Declaration_Node (gnat_entity)));
- /* Ignore deferred constant definitions; they are processed fully in the
- front-end. For deferred constant references get the full definition.
- On the other hand, constants that are renamings are handled like
- variable renamings. If No_Initialization is set, this is not a
- deferred constant but a constant whose value is built manually. */
- if (definition && !gnu_expr
+ /* Ignore deferred constant definitions without address clause since
+ they are processed fully in the front-end. If No_Initialization
+ is set, this is not a deferred constant but a constant whose value
+ is built manually. And constants that are renamings are handled
+ like variables. */
+ if (definition
+ && !gnu_expr
+ && No (Address_Clause (gnat_entity))
&& !No_Initialization (Declaration_Node (gnat_entity))
&& No (Renamed_Object (gnat_entity)))
{
@@ -404,12 +408,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
saved = true;
break;
}
- else if (!definition && IN (kind, Incomplete_Or_Private_Kind)
- && Present (Full_View (gnat_entity)))
+
+ /* Ignore constant definitions already marked with the error node. See
+ the N_Object_Declaration case of gnat_to_gnu for the rationale. */
+ if (definition
+ && gnu_expr
+ && present_gnu_tree (gnat_entity)
+ && get_gnu_tree (gnat_entity) == error_mark_node)
{
- gnu_decl = gnat_to_gnu_entity (Full_View (gnat_entity),
- NULL_TREE, 0);
- saved = true;
+ maybe_present = true;
break;
}
@@ -1037,17 +1044,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
&& !Is_Imported (gnat_entity) && !gnu_expr)
gnu_expr = integer_zero_node;
- /* If we are defining the object and it has an Address clause we must
- get the address expression from the saved GCC tree for the
- object if the object has a Freeze_Node. Otherwise, we elaborate
- the address expression here since the front-end has guaranteed
- in that case that the elaboration has no effects. Note that
- only the latter mechanism is currently in use. */
+ /* If we are defining the object and it has an Address clause, we must
+ either get the address expression from the saved GCC tree for the
+ object if it has a Freeze node, or elaborate the address expression
+ here since the front-end has guaranteed that the elaboration has no
+ effects in this case. */
if (definition && Present (Address_Clause (gnat_entity)))
{
tree gnu_address
- = (present_gnu_tree (gnat_entity) ? get_gnu_tree (gnat_entity)
- : gnat_to_gnu (Expression (Address_Clause (gnat_entity))));
+ = present_gnu_tree (gnat_entity)
+ ? get_gnu_tree (gnat_entity)
+ : gnat_to_gnu (Expression (Address_Clause (gnat_entity)));
save_gnu_tree (gnat_entity, NULL_TREE, false);
@@ -1064,6 +1071,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|| compile_time_known_address_p (Expression (Address_Clause
(gnat_entity)));
+ /* If this is a deferred constant, the initializer is attached to
+ the full view. */
+ if (kind == E_Constant && Present (Full_View (gnat_entity)))
+ gnu_expr
+ = gnat_to_gnu
+ (Expression (Declaration_Node (Full_View (gnat_entity))));
+
/* If we don't have an initializing expression for the underlying
variable, the initializing expression for the pointer is the
specified address. Otherwise, we have to make a COMPOUND_EXPR
@@ -1536,15 +1550,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_expr, 0);
gnu_type = make_node (INTEGER_TYPE);
+ TREE_TYPE (gnu_type) = get_unpadded_type (Etype (gnat_entity));
+
+ /* Set the precision to the Esize except for bit-packed arrays and
+ subtypes of Standard.Boolean. */
if (Is_Packed_Array_Type (gnat_entity)
&& Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)))
{
esize = UI_To_Int (RM_Size (gnat_entity));
TYPE_PACKED_ARRAY_TYPE_P (gnu_type) = 1;
}
+ else if (TREE_CODE (TREE_TYPE (gnu_type)) == BOOLEAN_TYPE)
+ esize = 1;
TYPE_PRECISION (gnu_type) = esize;
- TREE_TYPE (gnu_type) = get_unpadded_type (Etype (gnat_entity));
TYPE_MIN_VALUE (gnu_type)
= convert (TREE_TYPE (gnu_type),
@@ -1596,7 +1615,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
are uninitialized. Both goals are accomplished by wrapping the
modular value in an enclosing struct. */
if (Is_Packed_Array_Type (gnat_entity)
- && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)))
+ && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)))
{
tree gnu_field_type = gnu_type;
tree gnu_field;
@@ -3057,7 +3076,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* Discard old fields that are outside the new type.
This avoids confusing code scanning it to decide
- how to pass it to functions on some platforms. */
+ how to pass it to functions on some platforms. */
if (TREE_CODE (gnu_new_pos) == INTEGER_CST
&& TREE_CODE (TYPE_SIZE (gnu_type)) == INTEGER_CST
&& !integer_zerop (gnu_size)
@@ -3867,6 +3886,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
;
else if (By_Descriptor_Last <= mech && mech <= By_Descriptor)
mech = By_Descriptor;
+
+ else if (By_Short_Descriptor_Last <= mech &&
+ mech <= By_Short_Descriptor)
+ mech = By_Short_Descriptor;
+
else if (mech > 0)
{
if (TREE_CODE (gnu_param_type) == UNCONSTRAINED_ARRAY_TYPE
@@ -3908,7 +3932,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
= chainon (gnu_param, gnu_stub_param_list);
/* Change By_Descriptor parameter to By_Reference for
the internal version of an exported subprogram. */
- if (mech == By_Descriptor)
+ if (mech == By_Descriptor || mech == By_Short_Descriptor)
{
gnu_param
= gnat_to_gnu_param (gnat_param, By_Reference,
@@ -4015,19 +4039,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
if (TREE_CODE (gnu_return_type) == VOID_TYPE)
pure_flag = false;
- /* The semantics of "pure" in Ada essentially matches that of "const"
- in the back-end. In particular, both properties are orthogonal to
- the "nothrow" property. But this is true only if the EH circuitry
- is explicit in the internal representation of the back-end. If we
- are to completely hide the EH circuitry from it, we need to declare
- that calls to pure Ada subprograms that can throw have side effects
- since they can trigger an "abnormal" transfer of control flow; thus
- they can be neither "const" nor "pure" in the back-end sense. */
+ /* The semantics of "pure" in Ada used to essentially match that of
+ "const" in the middle-end. In particular, both properties were
+ orthogonal to the "nothrow" property. This is not true in the
+ middle-end any more and we have no choice but to ignore the hint
+ at this stage. */
+
gnu_type
= build_qualified_type (gnu_type,
TYPE_QUALS (gnu_type)
- | (Exception_Mechanism == Back_End_Exceptions
- ? TYPE_QUAL_CONST * pure_flag : 0)
| (TYPE_QUAL_VOLATILE * volatile_flag));
Sloc_to_locus (Sloc (gnat_entity), &input_location);
@@ -4821,13 +4841,13 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
gnu_param_type
= TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_param_type))));
- /* VMS descriptors are themselves passed by reference.
- Build both a 32bit and 64bit descriptor, one of which will be chosen
- in fill_vms_descriptor based on the allocator size */
+ /* VMS descriptors are themselves passed by reference. */
if (mech == By_Descriptor)
{
+ /* Build both a 32-bit and 64-bit descriptor, one of which will be
+ chosen in fill_vms_descriptor. */
gnu_param_type_alt
- = build_pointer_type (build_vms_descriptor64 (gnu_param_type,
+ = build_pointer_type (build_vms_descriptor32 (gnu_param_type,
Mechanism (gnat_param),
gnat_subprog));
gnu_param_type
@@ -4835,6 +4855,11 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
Mechanism (gnat_param),
gnat_subprog));
}
+ else if (mech == By_Short_Descriptor)
+ gnu_param_type
+ = build_pointer_type (build_vms_descriptor32 (gnu_param_type,
+ Mechanism (gnat_param),
+ gnat_subprog));
/* Arrays are passed as pointers to element type for foreign conventions. */
else if (foreign
@@ -4915,6 +4940,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
&& !by_ref
&& (by_return
|| (mech != By_Descriptor
+ && mech != By_Short_Descriptor
&& !POINTER_TYPE_P (gnu_param_type)
&& !AGGREGATE_TYPE_P (gnu_param_type)))
&& !(Is_Array_Type (Etype (gnat_param))
@@ -4926,12 +4952,14 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
ro_param || by_ref || by_component_ptr);
DECL_BY_REF_P (gnu_param) = by_ref;
DECL_BY_COMPONENT_PTR_P (gnu_param) = by_component_ptr;
- DECL_BY_DESCRIPTOR_P (gnu_param) = (mech == By_Descriptor);
+ DECL_BY_DESCRIPTOR_P (gnu_param) = (mech == By_Descriptor ||
+ mech == By_Short_Descriptor);
DECL_POINTS_TO_READONLY_P (gnu_param)
= (ro_param && (by_ref || by_component_ptr));
- /* Save the 64bit descriptor for later. */
- SET_DECL_PARM_ALT (gnu_param, gnu_param_type_alt);
+ /* Save the alternate descriptor type, if any. */
+ if (gnu_param_type_alt)
+ SET_DECL_PARM_ALT_TYPE (gnu_param, gnu_param_type_alt);
/* If no Mechanism was specified, indicate what we're using, then
back-annotate it. */
@@ -7106,7 +7134,8 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity)
if (TREE_CODE (gnu_type) == INTEGER_TYPE
&& Is_Discrete_Or_Fixed_Point_Type (gnat_entity))
TYPE_RM_SIZE_NUM (gnu_type) = size;
- else if (TREE_CODE (gnu_type) == ENUMERAL_TYPE)
+ else if (TREE_CODE (gnu_type) == ENUMERAL_TYPE
+ || TREE_CODE (gnu_type) == BOOLEAN_TYPE)
TYPE_RM_SIZE_NUM (gnu_type) = size;
else if ((TREE_CODE (gnu_type) == RECORD_TYPE
|| TREE_CODE (gnu_type) == UNION_TYPE
@@ -7124,7 +7153,7 @@ static tree
make_type_from_size (tree type, tree size_tree, bool for_biased)
{
unsigned HOST_WIDE_INT size;
- bool biased_p;
+ bool biased_p, boolean_p;
tree new_type;
/* If size indicates an error, just return TYPE to avoid propagating
@@ -7138,13 +7167,23 @@ make_type_from_size (tree type, tree size_tree, bool for_biased)
{
case INTEGER_TYPE:
case ENUMERAL_TYPE:
+ case BOOLEAN_TYPE:
biased_p = (TREE_CODE (type) == INTEGER_TYPE
&& TYPE_BIASED_REPRESENTATION_P (type));
+ boolean_p = (TREE_CODE (type) == BOOLEAN_TYPE
+ || (TREE_CODE (type) == INTEGER_TYPE
+ && TREE_TYPE (type)
+ && TREE_CODE (TREE_TYPE (type)) == BOOLEAN_TYPE));
+
+ if (boolean_p)
+ size = round_up_to_align (size, BITS_PER_UNIT);
+
/* Only do something if the type is not a packed array type and
doesn't already have the proper size. */
if (TYPE_PACKED_ARRAY_TYPE_P (type)
- || (TYPE_PRECISION (type) == size && biased_p == for_biased))
+ || (biased_p == for_biased && TYPE_PRECISION (type) == size)
+ || (boolean_p && compare_tree_int (TYPE_SIZE (type), size) == 0))
break;
biased_p |= for_biased;
@@ -7154,13 +7193,18 @@ make_type_from_size (tree type, tree size_tree, bool for_biased)
new_type = make_unsigned_type (size);
else
new_type = make_signed_type (size);
+ if (boolean_p)
+ TYPE_PRECISION (new_type) = 1;
TREE_TYPE (new_type) = TREE_TYPE (type) ? TREE_TYPE (type) : type;
TYPE_MIN_VALUE (new_type)
= convert (TREE_TYPE (new_type), TYPE_MIN_VALUE (type));
TYPE_MAX_VALUE (new_type)
= convert (TREE_TYPE (new_type), TYPE_MAX_VALUE (type));
TYPE_BIASED_REPRESENTATION_P (new_type) = biased_p;
- TYPE_RM_SIZE_NUM (new_type) = bitsize_int (size);
+ if (boolean_p)
+ TYPE_RM_SIZE_NUM (new_type) = bitsize_int (1);
+ else
+ TYPE_RM_SIZE_NUM (new_type) = bitsize_int (size);
return new_type;
case RECORD_TYPE:
diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index 685bb383bbd..915e44f0e0e 100644
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -218,6 +218,7 @@ extern void gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
struct List_Header *list_headers_ptr,
Nat number_file,
struct File_Info_Type *file_info_ptr,
+ Entity_Id standard_boolean,
Entity_Id standard_integer,
Entity_Id standard_long_long_float,
Entity_Id standard_exception_type,
@@ -393,6 +394,9 @@ enum standard_datatypes
/* Likewise for freeing memory. */
ADT_free_decl,
+ /* Function decl node for 64-bit multiplication with overflow checking */
+ ADT_mulv64_decl,
+
/* Types and decls used by our temporary exception mechanism. See
init_gigi_decls for details. */
ADT_jmpbuf_type,
@@ -424,6 +428,7 @@ extern GTY(()) tree gnat_raise_decls[(int) LAST_REASON_CODE + 1];
#define malloc_decl gnat_std_decls[(int) ADT_malloc_decl]
#define malloc32_decl gnat_std_decls[(int) ADT_malloc32_decl]
#define free_decl gnat_std_decls[(int) ADT_free_decl]
+#define mulv64_decl gnat_std_decls[(int) ADT_mulv64_decl]
#define jmpbuf_type gnat_std_decls[(int) ADT_jmpbuf_type]
#define jmpbuf_ptr_type gnat_std_decls[(int) ADT_jmpbuf_ptr_type]
#define get_jmpbuf_decl gnat_std_decls[(int) ADT_get_jmpbuf_decl]
@@ -678,7 +683,7 @@ extern void end_subprog_body (tree body, bool elab_p);
Return a constructor for the template. */
extern tree build_template (tree template_type, tree array_type, tree expr);
-/* Build a 32bit VMS descriptor from a Mechanism_Type, which must specify
+/* Build a 64bit VMS descriptor from a Mechanism_Type, which must specify
a descriptor type, and the GCC type of an object. Each FIELD_DECL
in the type contains in its DECL_INITIAL the expression to use when
a constructor is made for the type. GNAT_ENTITY is a gnat node used
@@ -687,8 +692,8 @@ extern tree build_template (tree template_type, tree array_type, tree expr);
extern tree build_vms_descriptor (tree type, Mechanism_Type mech,
Entity_Id gnat_entity);
-/* Build a 64bit VMS descriptor from a Mechanism_Type. See above. */
-extern tree build_vms_descriptor64 (tree type, Mechanism_Type mech,
+/* Build a 32bit VMS descriptor from a Mechanism_Type. See above. */
+extern tree build_vms_descriptor32 (tree type, Mechanism_Type mech,
Entity_Id gnat_entity);
/* Build a stub for the subprogram specified by the GCC tree GNU_SUBPROG
@@ -848,9 +853,8 @@ extern tree build_allocator (tree type, tree init, tree result_type,
Node_Id gnat_node, bool);
/* Fill in a VMS descriptor for EXPR and return a constructor for it.
- GNAT_FORMAL is how we find the descriptor record. GNAT_ACTUAL is how we
- find the size of the allocator. */
-extern tree fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual);
+ GNAT_FORMAL is how we find the descriptor record. */
+extern tree fill_vms_descriptor (tree expr, Entity_Id gnat_formal);
/* Indicate that we need to make the address of EXPR_NODE and it therefore
should not be allocated in a register. Return true if successful. */
diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c
index 02397d7f445..47d249a4578 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -544,6 +544,7 @@ gnat_print_type (FILE *file, tree node, int indent)
break;
case ENUMERAL_TYPE:
+ case BOOLEAN_TYPE:
print_node (file, "RM size", TYPE_RM_SIZE_NUM (node), indent + 4);
break;
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 3b15e30a222..43e6afb915a 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -205,6 +205,8 @@ static void process_decls (List_Id, List_Id, Node_Id, bool, bool);
static tree emit_range_check (tree, Node_Id);
static tree emit_index_check (tree, tree, tree, tree);
static tree emit_check (tree, tree, int);
+static tree build_unary_op_trapv (enum tree_code, tree, tree);
+static tree build_binary_op_trapv (enum tree_code, tree, tree, tree);
static tree convert_with_check (Entity_Id, tree, bool, bool, bool);
static bool smaller_packable_type_p (tree, tree);
static bool addressable_p (tree, tree);
@@ -231,12 +233,12 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
struct Elist_Header *elists_ptr, struct Elmt_Item *elmts_ptr,
struct String_Entry *strings_ptr, Char_Code *string_chars_ptr,
struct List_Header *list_headers_ptr, Nat number_file,
- struct File_Info_Type *file_info_ptr,
+ struct File_Info_Type *file_info_ptr, Entity_Id standard_boolean,
Entity_Id standard_integer, Entity_Id standard_long_long_float,
Entity_Id standard_exception_type, Int gigi_operating_mode)
{
- tree gnu_standard_long_long_float;
- tree gnu_standard_exception_type;
+ Entity_Id gnat_literal;
+ tree gnu_standard_long_long_float, gnu_standard_exception_type, t;
struct elab_info *info;
int i;
@@ -311,6 +313,8 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
/* Give names and make TYPE_DECLs for common types. */
create_type_decl (get_identifier (SIZE_TYPE), sizetype,
NULL, false, true, Empty);
+ create_type_decl (get_identifier ("boolean"), boolean_type_node,
+ NULL, false, true, Empty);
create_type_decl (get_identifier ("integer"), integer_type_node,
NULL, false, true, Empty);
create_type_decl (get_identifier ("unsigned char"), char_type_node,
@@ -318,6 +322,26 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
create_type_decl (get_identifier ("long integer"), long_integer_type_node,
NULL, false, true, Empty);
+ /* Save the type we made for boolean as the type for Standard.Boolean. */
+ save_gnu_tree (Base_Type (standard_boolean), TYPE_NAME (boolean_type_node),
+ false);
+ gnat_literal = First_Literal (Base_Type (standard_boolean));
+ t = UI_To_gnu (Enumeration_Rep (gnat_literal), boolean_type_node);
+ gcc_assert (t == boolean_false_node);
+ t = create_var_decl (get_entity_name (gnat_literal), NULL_TREE,
+ boolean_type_node, t, true, false, false, false,
+ NULL, gnat_literal);
+ DECL_IGNORED_P (t) = 1;
+ save_gnu_tree (gnat_literal, t, false);
+ gnat_literal = Next_Literal (gnat_literal);
+ t = UI_To_gnu (Enumeration_Rep (gnat_literal), boolean_type_node);
+ gcc_assert (t == boolean_true_node);
+ t = create_var_decl (get_entity_name (gnat_literal), NULL_TREE,
+ boolean_type_node, t, true, false, false, false,
+ NULL, gnat_literal);
+ DECL_IGNORED_P (t) = 1;
+ save_gnu_tree (gnat_literal, t, false);
+
/* Save the type we made for integer as the type for Standard.Integer.
Then make the rest of the standard types. Note that some of these
may be subtypes. */
@@ -2368,8 +2392,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
else
gnu_actual = build_unary_op (ADDR_EXPR, NULL_TREE,
fill_vms_descriptor (gnu_actual,
- gnat_formal,
- gnat_actual));
+ gnat_formal));
}
else
{
@@ -3374,6 +3397,15 @@ gnat_to_gnu (Node_Id gnat_node)
if (type_annotate_only && gnu_expr && TREE_CODE (gnu_expr) == ERROR_MARK)
gnu_expr = NULL_TREE;
+ /* If this is a deferred constant with an address clause, we ignore the
+ full view since the clause is on the partial view and we cannot have
+ 2 different GCC trees for the object. The only bits of the full view
+ we will use is the initializer, but it will be directly fetched. */
+ if (Ekind(gnat_temp) == E_Constant
+ && Present (Address_Clause (gnat_temp))
+ && Present (Full_View (gnat_temp)))
+ save_gnu_tree (Full_View (gnat_temp), error_mark_node, true);
+
if (No (Freeze_Node (gnat_temp)))
gnat_to_gnu_entity (gnat_temp, gnu_expr, 1);
break;
@@ -3917,7 +3949,22 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_rhs = convert (gnu_type, gnu_rhs);
}
- gnu_result = build_binary_op (code, gnu_type, gnu_lhs, gnu_rhs);
+ /* Instead of expanding overflow checks for addition, subtraction
+ and multiplication itself, the front end will leave this to
+ the back end when Backend_Overflow_Checks_On_Target is set.
+ As the GCC back end itself does not know yet how to properly
+ do overflow checking, do it here. The goal is to push
+ the expansions further into the back end over time. */
+ if (Do_Overflow_Check (gnat_node) && Backend_Overflow_Checks_On_Target
+ && (Nkind (gnat_node) == N_Op_Add
+ || Nkind (gnat_node) == N_Op_Subtract
+ || Nkind (gnat_node) == N_Op_Multiply)
+ && !TYPE_UNSIGNED (gnu_type)
+ && !FLOAT_TYPE_P (gnu_type))
+ gnu_result
+ = build_binary_op_trapv (code, gnu_type, gnu_lhs, gnu_rhs);
+ else
+ gnu_result = build_binary_op (code, gnu_type, gnu_lhs, gnu_rhs);
/* If this is a logical shift with the shift count not verified,
we must return zero if it is too large. We cannot compensate
@@ -3982,8 +4029,14 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_result_type = get_unpadded_type (Base_Type
(Full_View (Etype (gnat_node))));
- gnu_result = build_unary_op (gnu_codes[Nkind (gnat_node)],
- gnu_result_type, gnu_expr);
+ if (Do_Overflow_Check (gnat_node)
+ && !TYPE_UNSIGNED (gnu_result_type)
+ && !FLOAT_TYPE_P (gnu_result_type))
+ gnu_result = build_unary_op_trapv (gnu_codes[Nkind (gnat_node)],
+ gnu_result_type, gnu_expr);
+ else
+ gnu_result = build_unary_op (gnu_codes[Nkind (gnat_node)],
+ gnu_result_type, gnu_expr);
break;
case N_Allocator:
@@ -4497,21 +4550,22 @@ gnat_to_gnu (Node_Id gnat_node)
/***************************************************/
case N_Attribute_Definition_Clause:
-
gnu_result = alloc_stmt_list ();
- /* The only one we need deal with is for 'Address. For the others, SEM
- puts the information elsewhere. We need only deal with 'Address
- if the object has a Freeze_Node (which it never will currently). */
- if (Get_Attribute_Id (Chars (gnat_node)) != Attr_Address
- || No (Freeze_Node (Entity (Name (gnat_node)))))
+ /* The only one we need to deal with is 'Address since, for the others,
+ the front-end puts the information elsewhere. */
+ if (Get_Attribute_Id (Chars (gnat_node)) != Attr_Address)
break;
- /* Get the value to use as the address and save it as the
- equivalent for GNAT_TEMP. When the object is frozen,
- gnat_to_gnu_entity will do the right thing. */
- save_gnu_tree (Entity (Name (gnat_node)),
- gnat_to_gnu (Expression (gnat_node)), true);
+ /* And we only deal with 'Address if the object has a Freeze node. */
+ gnat_temp = Entity (Name (gnat_node));
+ if (No (Freeze_Node (gnat_temp)))
+ break;
+
+ /* Get the value to use as the address and save it as the equivalent
+ for the object. When it is frozen, gnat_to_gnu_entity will do the
+ right thing. */
+ save_gnu_tree (gnat_temp, gnat_to_gnu (Expression (gnat_node)), true);
break;
case N_Enumeration_Representation_Clause:
@@ -5853,6 +5907,159 @@ process_decls (List_Id gnat_decls, List_Id gnat_decls2,
}
}
+/* Make a unary operation of kind CODE using build_unary_op, but guard
+ the operation by an overflow check. CODE can be one of NEGATE_EXPR
+ or ABS_EXPR. GNU_TYPE is the type desired for the result.
+ Usually the operation is to be performed in that type. */
+
+static tree
+build_unary_op_trapv (enum tree_code code,
+ tree gnu_type,
+ tree operand)
+{
+ gcc_assert ((code == NEGATE_EXPR) || (code == ABS_EXPR));
+
+ operand = protect_multiple_eval (operand);
+
+ return emit_check (build_binary_op (EQ_EXPR, integer_type_node,
+ operand, TYPE_MIN_VALUE (gnu_type)),
+ build_unary_op (code, gnu_type, operand),
+ CE_Overflow_Check_Failed);
+}
+
+/* Make a binary operation of kind CODE using build_binary_op, but
+ guard the operation by an overflow check. CODE can be one of
+ PLUS_EXPR, MINUS_EXPR or MULT_EXPR. GNU_TYPE is the type desired
+ for the result. Usually the operation is to be performed in that type. */
+
+static tree
+build_binary_op_trapv (enum tree_code code,
+ tree gnu_type,
+ tree left,
+ tree right)
+{
+ tree lhs = protect_multiple_eval (left);
+ tree rhs = protect_multiple_eval (right);
+ tree type_max = TYPE_MAX_VALUE (gnu_type);
+ tree type_min = TYPE_MIN_VALUE (gnu_type);
+ tree gnu_expr;
+ tree tmp1, tmp2;
+ tree zero = convert (gnu_type, integer_zero_node);
+ tree rhs_ge_zero;
+ tree check_pos;
+ tree check_neg;
+
+ int precision = TYPE_PRECISION (gnu_type);
+
+ /* Prefer a constant rhs to simplify checks */
+
+ if (TREE_CONSTANT (lhs) && !TREE_CONSTANT (rhs)
+ && commutative_tree_code (code))
+ {
+ tree tmp = lhs;
+ lhs = rhs;
+ rhs = tmp;
+ }
+
+ /* In the case the right-hand size is still not constant, try to
+ use an exact operation in a wider type. */
+
+ if (!TREE_CONSTANT (rhs))
+ {
+ int needed_precision = code == MULT_EXPR ? 2 * precision : precision + 1;
+
+ if (code == MULT_EXPR && precision == 64)
+ {
+ return build_call_2_expr (mulv64_decl, lhs, rhs);
+ }
+ else if (needed_precision <= LONG_LONG_TYPE_SIZE)
+ {
+ tree calc_type = gnat_type_for_size (needed_precision, 0);
+ tree result;
+ tree check;
+
+ result = build_binary_op (code, calc_type,
+ convert (calc_type, lhs),
+ convert (calc_type, rhs));
+
+ check = build_binary_op
+ (TRUTH_ORIF_EXPR, integer_type_node,
+ build_binary_op (LT_EXPR, integer_type_node, result,
+ convert (calc_type, type_min)),
+ build_binary_op (GT_EXPR, integer_type_node, result,
+ convert (calc_type, type_max)));
+
+ result = convert (gnu_type, result);
+
+ return emit_check (check, result, CE_Overflow_Check_Failed);
+ }
+ }
+
+ gnu_expr = build_binary_op (code, gnu_type, lhs, rhs);
+ rhs_ge_zero = build_binary_op (GE_EXPR, integer_type_node, rhs, zero);
+
+ switch (code)
+ {
+ case PLUS_EXPR:
+ /* When rhs >= 0, overflow when lhs > type_max - rhs */
+ check_pos = build_binary_op (GT_EXPR, integer_type_node, lhs,
+ build_binary_op (MINUS_EXPR, gnu_type,
+ type_max, rhs)),
+
+ /* When rhs < 0, overflow when lhs < type_min - rhs */
+ check_neg = build_binary_op (LT_EXPR, integer_type_node, lhs,
+ build_binary_op (MINUS_EXPR, gnu_type,
+ type_min, rhs));
+ break;
+
+ case MINUS_EXPR:
+ /* When rhs >= 0, overflow when lhs < type_min + rhs */
+ check_pos = build_binary_op (LT_EXPR, integer_type_node, lhs,
+ build_binary_op (PLUS_EXPR, gnu_type,
+ type_min, rhs)),
+
+ /* When rhs < 0, overflow when lhs > type_max + rhs */
+ check_neg = build_binary_op (GT_EXPR, integer_type_node, lhs,
+ build_binary_op (PLUS_EXPR, gnu_type,
+ type_max, rhs));
+ break;
+
+ case MULT_EXPR:
+ /* The check here is designed to be efficient if the rhs is constant,
+ Four different check expressions determine wether X * C overflows,
+ depending on C.
+ C == 0 => false
+ C > 0 => X > type_max / C || X < type_min / C
+ C == -1 => X == type_min
+ C < -1 => X > type_min / C || X < type_max / C */
+
+ tmp1 = build_binary_op (TRUNC_DIV_EXPR, gnu_type, type_max, rhs);
+ tmp2 = build_binary_op (TRUNC_DIV_EXPR, gnu_type, type_min, rhs);
+
+ check_pos = build_binary_op (TRUTH_ANDIF_EXPR, integer_type_node,
+ build_binary_op (NE_EXPR, integer_type_node, zero, rhs),
+ build_binary_op (TRUTH_ORIF_EXPR, integer_type_node,
+ build_binary_op (GT_EXPR, integer_type_node, lhs, tmp1),
+ build_binary_op (LT_EXPR, integer_type_node, lhs, tmp2)));
+
+ check_neg = fold_build3 (COND_EXPR, integer_type_node,
+ build_binary_op (EQ_EXPR, integer_type_node, rhs,
+ build_int_cst (gnu_type, -1)),
+ build_binary_op (EQ_EXPR, integer_type_node, lhs, type_min),
+ build_binary_op (TRUTH_ORIF_EXPR, integer_type_node,
+ build_binary_op (GT_EXPR, integer_type_node, lhs, tmp2),
+ build_binary_op (LT_EXPR, integer_type_node, lhs, tmp1)));
+ break;
+
+ default:
+ gcc_unreachable();
+ }
+
+ return emit_check (fold_build3 (COND_EXPR, integer_type_node, rhs_ge_zero,
+ check_pos, check_neg),
+ gnu_expr, CE_Overflow_Check_Failed);
+}
+
/* Emit code for a range check. GNU_EXPR is the expression to be checked,
GNAT_RANGE_TYPE the gnat type or subtype containing the bounds against
which we have to check. */
diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index 01cc9b8948e..dcf0558ec9d 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -523,6 +523,13 @@ gnat_init_decl_processing (void)
this before we can expand the GNAT types. */
size_type_node = gnat_type_for_size (GET_MODE_BITSIZE (Pmode), 0);
set_sizetype (size_type_node);
+
+ /* In Ada, we use an unsigned 8-bit type for the default boolean type. */
+ boolean_type_node = make_node (BOOLEAN_TYPE);
+ TYPE_PRECISION (boolean_type_node) = 1;
+ fixup_unsigned_type (boolean_type_node);
+ TYPE_RM_SIZE_NUM (boolean_type_node) = bitsize_int (1);
+
build_common_tree_nodes_2 (0);
ptr_void_type_node = build_pointer_type (void_type_node);
@@ -535,6 +542,7 @@ void
init_gigi_decls (tree long_long_float_type, tree exception_type)
{
tree endlink, decl;
+ tree int64_type = gnat_type_for_size (64, 0);
unsigned int i;
/* Set the types that GCC and Gigi use from the front end. We would like
@@ -623,6 +631,13 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
endlink)),
NULL_TREE, false, true, true, NULL, Empty);
+ /* This is used for 64-bit multiplication with overflow checking. */
+ mulv64_decl
+ = create_subprog_decl (get_identifier ("__gnat_mulv64"), NULL_TREE,
+ build_function_type_list (int64_type, int64_type,
+ int64_type, NULL_TREE),
+ NULL_TREE, false, true, true, NULL, Empty);
+
/* Make the types and functions used for exception processing. */
jmpbuf_type
= build_array_type (gnat_type_for_mode (Pmode, 0),
@@ -1740,7 +1755,7 @@ create_field_decl (tree field_name, tree field_type, tree record_type,
of a copy. This is the case for true bitfields, but the DECL_BIT_FIELD
value we have at this point is not accurate enough, so we don't account
for this here and let finish_record_type decide. */
- if (!type_for_nonaliased_component_p (field_type))
+ if (!addressable && !type_for_nonaliased_component_p (field_type))
addressable = 1;
DECL_NONADDRESSABLE_P (field_decl) = !addressable;
@@ -1762,7 +1777,8 @@ create_param_decl (tree param_name, tree param_type, bool readonly)
lead to various ABI violations. */
if (targetm.calls.promote_prototypes (param_type)
&& (TREE_CODE (param_type) == INTEGER_TYPE
- || TREE_CODE (param_type) == ENUMERAL_TYPE)
+ || TREE_CODE (param_type) == ENUMERAL_TYPE
+ || TREE_CODE (param_type) == BOOLEAN_TYPE)
&& TYPE_PRECISION (param_type) < TYPE_PRECISION (integer_type_node))
{
/* We have to be careful about biased types here. Make a subtype
@@ -2643,7 +2659,7 @@ build_template (tree template_type, tree array_type, tree expr)
an object of that type and also for the name. */
tree
-build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
+build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
{
tree record_type = make_node (RECORD_TYPE);
tree pointer32_type;
@@ -2673,7 +2689,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
idx_arr = (tree *) alloca (ndim * sizeof (tree));
- if (mech != By_Descriptor_NCA
+ if (mech != By_Descriptor_NCA && mech != By_Short_Descriptor_NCA
&& TREE_CODE (type) == ARRAY_TYPE && TYPE_CONVENTION_FORTRAN_P (type))
for (i = ndim - 1, inner_type = type;
i >= 0;
@@ -2690,6 +2706,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
{
case INTEGER_TYPE:
case ENUMERAL_TYPE:
+ case BOOLEAN_TYPE:
if (TYPE_VAX_FLOATING_POINT_P (type))
switch (tree_low_cst (TYPE_DIGITS_VALUE (type), 1))
{
@@ -2758,16 +2775,21 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
switch (mech)
{
case By_Descriptor_A:
+ case By_Short_Descriptor_A:
class = 4;
break;
case By_Descriptor_NCA:
+ case By_Short_Descriptor_NCA:
class = 10;
break;
case By_Descriptor_SB:
+ case By_Short_Descriptor_SB:
class = 15;
break;
case By_Descriptor:
+ case By_Short_Descriptor:
case By_Descriptor_S:
+ case By_Short_Descriptor_S:
default:
class = 1;
break;
@@ -2780,7 +2802,9 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
= chainon (field_list,
make_descriptor_field
("LENGTH", gnat_type_for_size (16, 1), record_type,
- size_in_bytes (mech == By_Descriptor_A ? inner_type : type)));
+ size_in_bytes ((mech == By_Descriptor_A ||
+ mech == By_Short_Descriptor_A)
+ ? inner_type : type)));
field_list = chainon (field_list,
make_descriptor_field ("DTYPE",
@@ -2806,10 +2830,13 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
switch (mech)
{
case By_Descriptor:
+ case By_Short_Descriptor:
case By_Descriptor_S:
+ case By_Short_Descriptor_S:
break;
case By_Descriptor_SB:
+ case By_Short_Descriptor_SB:
field_list
= chainon (field_list,
make_descriptor_field
@@ -2825,7 +2852,9 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
break;
case By_Descriptor_A:
+ case By_Short_Descriptor_A:
case By_Descriptor_NCA:
+ case By_Short_Descriptor_NCA:
field_list = chainon (field_list,
make_descriptor_field ("SCALE",
gnat_type_for_size (8, 1),
@@ -2842,7 +2871,8 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
= chainon (field_list,
make_descriptor_field
("AFLAGS", gnat_type_for_size (8, 1), record_type,
- size_int (mech == By_Descriptor_NCA
+ size_int ((mech == By_Descriptor_NCA ||
+ mech == By_Short_Descriptor_NCA)
? 0
/* Set FL_COLUMN, FL_COEFF, and FL_BOUNDS. */
: (TREE_CODE (type) == ARRAY_TYPE
@@ -2893,7 +2923,8 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
TYPE_MIN_VALUE (idx_arr[i])),
size_int (1)));
- fname[0] = (mech == By_Descriptor_NCA ? 'S' : 'M');
+ fname[0] = ((mech == By_Descriptor_NCA ||
+ mech == By_Short_Descriptor_NCA) ? 'S' : 'M');
fname[1] = '0' + i, fname[2] = 0;
field_list
= chainon (field_list,
@@ -2901,7 +2932,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
gnat_type_for_size (32, 1),
record_type, idx_length));
- if (mech == By_Descriptor_NCA)
+ if (mech == By_Descriptor_NCA || mech == By_Short_Descriptor_NCA)
tem = idx_length;
}
@@ -2945,7 +2976,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
an object of that type and also for the name. */
tree
-build_vms_descriptor64 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
+build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
{
tree record64_type = make_node (RECORD_TYPE);
tree pointer64_type;
@@ -2992,6 +3023,7 @@ build_vms_descriptor64 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
{
case INTEGER_TYPE:
case ENUMERAL_TYPE:
+ case BOOLEAN_TYPE:
if (TYPE_VAX_FLOATING_POINT_P (type))
switch (tree_low_cst (TYPE_DIGITS_VALUE (type), 1))
{
@@ -3265,12 +3297,160 @@ make_descriptor_field (const char *name, tree type,
return field;
}
-/* Convert GNU_EXPR, a pointer to a VMS descriptor, to GNU_TYPE, a regular
- pointer or fat pointer type. GNAT_SUBPROG is the subprogram to which
- the VMS descriptor is passed. */
+/* Convert GNU_EXPR, a pointer to a 64bit VMS descriptor, to GNU_TYPE, a
+ regular pointer or fat pointer type. GNAT_SUBPROG is the subprogram to
+ which the VMS descriptor is passed. */
static tree
-convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
+convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
+{
+ tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr));
+ tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr);
+ /* The CLASS field is the 3rd field in the descriptor. */
+ tree class = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type)));
+ /* The POINTER field is the 6th field in the descriptor. */
+ tree pointer64 = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (class)));
+
+ /* Retrieve the value of the POINTER field. */
+ tree gnu_expr64
+ = build3 (COMPONENT_REF, TREE_TYPE (pointer64), desc, pointer64, NULL_TREE);
+
+ if (POINTER_TYPE_P (gnu_type))
+ return convert (gnu_type, gnu_expr64);
+
+ else if (TYPE_FAT_POINTER_P (gnu_type))
+ {
+ tree p_array_type = TREE_TYPE (TYPE_FIELDS (gnu_type));
+ tree p_bounds_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type)));
+ tree template_type = TREE_TYPE (p_bounds_type);
+ tree min_field = TYPE_FIELDS (template_type);
+ tree max_field = TREE_CHAIN (TYPE_FIELDS (template_type));
+ tree template, template_addr, aflags, dimct, t, u;
+ /* See the head comment of build_vms_descriptor. */
+ int iclass = TREE_INT_CST_LOW (DECL_INITIAL (class));
+ tree lfield, ufield;
+
+ /* Convert POINTER to the type of the P_ARRAY field. */
+ gnu_expr64 = convert (p_array_type, gnu_expr64);
+
+ switch (iclass)
+ {
+ case 1: /* Class S */
+ case 15: /* Class SB */
+ /* Build {1, LENGTH} template; LENGTH64 is the 5th field. */
+ t = TREE_CHAIN (TREE_CHAIN (class));
+ t = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
+ t = tree_cons (min_field,
+ convert (TREE_TYPE (min_field), integer_one_node),
+ tree_cons (max_field,
+ convert (TREE_TYPE (max_field), t),
+ NULL_TREE));
+ template = gnat_build_constructor (template_type, t);
+ template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template);
+
+ /* For class S, we are done. */
+ if (iclass == 1)
+ break;
+
+ /* Test that we really have a SB descriptor, like DEC Ada. */
+ t = build3 (COMPONENT_REF, TREE_TYPE (class), desc, class, NULL);
+ u = convert (TREE_TYPE (class), DECL_INITIAL (class));
+ u = build_binary_op (EQ_EXPR, integer_type_node, t, u);
+ /* If so, there is already a template in the descriptor and
+ it is located right after the POINTER field. The fields are
+ 64bits so they must be repacked. */
+ t = TREE_CHAIN (pointer64);
+ lfield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
+ lfield = convert (TREE_TYPE (TYPE_FIELDS (template_type)), lfield);
+
+ t = TREE_CHAIN (t);
+ ufield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
+ ufield = convert
+ (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (template_type))), ufield);
+
+ /* Build the template in the form of a constructor. */
+ t = tree_cons (TYPE_FIELDS (template_type), lfield,
+ tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)),
+ ufield, NULL_TREE));
+ template = gnat_build_constructor (template_type, t);
+
+ /* Otherwise use the {1, LENGTH} template we build above. */
+ template_addr = build3 (COND_EXPR, p_bounds_type, u,
+ build_unary_op (ADDR_EXPR, p_bounds_type,
+ template),
+ template_addr);
+ break;
+
+ case 4: /* Class A */
+ /* The AFLAGS field is the 3rd field after the pointer in the
+ descriptor. */
+ t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (pointer64)));
+ aflags = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
+ /* The DIMCT field is the next field in the descriptor after
+ aflags. */
+ t = TREE_CHAIN (t);
+ dimct = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
+ /* Raise CONSTRAINT_ERROR if either more than 1 dimension
+ or FL_COEFF or FL_BOUNDS not set. */
+ u = build_int_cst (TREE_TYPE (aflags), 192);
+ u = build_binary_op (TRUTH_OR_EXPR, integer_type_node,
+ build_binary_op (NE_EXPR, integer_type_node,
+ dimct,
+ convert (TREE_TYPE (dimct),
+ size_one_node)),
+ build_binary_op (NE_EXPR, integer_type_node,
+ build2 (BIT_AND_EXPR,
+ TREE_TYPE (aflags),
+ aflags, u),
+ u));
+ /* There is already a template in the descriptor and it is located
+ in block 3. The fields are 64bits so they must be repacked. */
+ t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN
+ (t)))));
+ lfield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
+ lfield = convert (TREE_TYPE (TYPE_FIELDS (template_type)), lfield);
+
+ t = TREE_CHAIN (t);
+ ufield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
+ ufield = convert
+ (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (template_type))), ufield);
+
+ /* Build the template in the form of a constructor. */
+ t = tree_cons (TYPE_FIELDS (template_type), lfield,
+ tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)),
+ ufield, NULL_TREE));
+ template = gnat_build_constructor (template_type, t);
+ template = build3 (COND_EXPR, p_bounds_type, u,
+ build_call_raise (CE_Length_Check_Failed, Empty,
+ N_Raise_Constraint_Error),
+ template);
+ template_addr = build_unary_op (ADDR_EXPR, p_bounds_type, template);
+ break;
+
+ case 10: /* Class NCA */
+ default:
+ post_error ("unsupported descriptor type for &", gnat_subprog);
+ template_addr = integer_zero_node;
+ break;
+ }
+
+ /* Build the fat pointer in the form of a constructor. */
+ t = tree_cons (TYPE_FIELDS (gnu_type), gnu_expr64,
+ tree_cons (TREE_CHAIN (TYPE_FIELDS (gnu_type)),
+ template_addr, NULL_TREE));
+ return gnat_build_constructor (gnu_type, t);
+ }
+
+ else
+ gcc_unreachable ();
+}
+
+/* Convert GNU_EXPR, a pointer to a 32bit VMS descriptor, to GNU_TYPE, a
+ regular pointer or fat pointer type. GNAT_SUBPROG is the subprogram to
+ which the VMS descriptor is passed. */
+
+static tree
+convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
{
tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr));
tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr);
@@ -3280,11 +3460,11 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
tree pointer = TREE_CHAIN (class);
/* Retrieve the value of the POINTER field. */
- gnu_expr
+ tree gnu_expr32
= build3 (COMPONENT_REF, TREE_TYPE (pointer), desc, pointer, NULL_TREE);
if (POINTER_TYPE_P (gnu_type))
- return convert (gnu_type, gnu_expr);
+ return convert (gnu_type, gnu_expr32);
else if (TYPE_FAT_POINTER_P (gnu_type))
{
@@ -3298,7 +3478,7 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
int iclass = TREE_INT_CST_LOW (DECL_INITIAL (class));
/* Convert POINTER to the type of the P_ARRAY field. */
- gnu_expr = convert (p_array_type, gnu_expr);
+ gnu_expr32 = convert (p_array_type, gnu_expr32);
switch (iclass)
{
@@ -3354,14 +3534,14 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
TREE_TYPE (aflags),
aflags, u),
u));
- add_stmt (build3 (COND_EXPR, void_type_node, u,
- build_call_raise (CE_Length_Check_Failed, Empty,
- N_Raise_Constraint_Error),
- NULL_TREE));
/* There is already a template in the descriptor and it is
located at the start of block 3 (12th field). */
t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (t))));
template = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
+ template = build3 (COND_EXPR, p_bounds_type, u,
+ build_call_raise (CE_Length_Check_Failed, Empty,
+ N_Raise_Constraint_Error),
+ template);
template_addr = build_unary_op (ADDR_EXPR, p_bounds_type, template);
break;
@@ -3373,9 +3553,10 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
}
/* Build the fat pointer in the form of a constructor. */
- t = tree_cons (TYPE_FIELDS (gnu_type), gnu_expr,
+ t = tree_cons (TYPE_FIELDS (gnu_type), gnu_expr32,
tree_cons (TREE_CHAIN (TYPE_FIELDS (gnu_type)),
template_addr, NULL_TREE));
+
return gnat_build_constructor (gnu_type, t);
}
@@ -3383,6 +3564,47 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
gcc_unreachable ();
}
+/* Convert GNU_EXPR, a pointer to a VMS descriptor, to GNU_TYPE, a regular
+ pointer or fat pointer type. GNU_EXPR_ALT_TYPE is the alternate (32-bit)
+ pointer type of GNU_EXPR. GNAT_SUBPROG is the subprogram to which the
+ VMS descriptor is passed. */
+
+static tree
+convert_vms_descriptor (tree gnu_type, tree gnu_expr, tree gnu_expr_alt_type,
+ Entity_Id gnat_subprog)
+{
+ tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr));
+ tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr);
+ tree mbo = TYPE_FIELDS (desc_type);
+ const char *mbostr = IDENTIFIER_POINTER (DECL_NAME (mbo));
+ tree mbmo = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (mbo)));
+ tree is64bit, gnu_expr32, gnu_expr64;
+
+ /* If the field name is not MBO, it must be 32-bit and no alternate.
+ Otherwise primary must be 64-bit and alternate 32-bit. */
+ if (strcmp (mbostr, "MBO") != 0)
+ return convert_vms_descriptor32 (gnu_type, gnu_expr, gnat_subprog);
+
+ /* Build the test for 64-bit descriptor. */
+ mbo = build3 (COMPONENT_REF, TREE_TYPE (mbo), desc, mbo, NULL_TREE);
+ mbmo = build3 (COMPONENT_REF, TREE_TYPE (mbmo), desc, mbmo, NULL_TREE);
+ is64bit
+ = build_binary_op (TRUTH_ANDIF_EXPR, integer_type_node,
+ build_binary_op (EQ_EXPR, integer_type_node,
+ convert (integer_type_node, mbo),
+ integer_one_node),
+ build_binary_op (EQ_EXPR, integer_type_node,
+ convert (integer_type_node, mbmo),
+ integer_minus_one_node));
+
+ /* Build the 2 possible end results. */
+ gnu_expr64 = convert_vms_descriptor64 (gnu_type, gnu_expr, gnat_subprog);
+ gnu_expr = fold_convert (gnu_expr_alt_type, gnu_expr);
+ gnu_expr32 = convert_vms_descriptor32 (gnu_type, gnu_expr, gnat_subprog);
+
+ return build3 (COND_EXPR, gnu_type, is64bit, gnu_expr64, gnu_expr32);
+}
+
/* Build a stub for the subprogram specified by the GCC tree GNU_SUBPROG
and the GNAT node GNAT_SUBPROG. */
@@ -3411,8 +3633,11 @@ build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog)
gnu_arg_types = TREE_CHAIN (gnu_arg_types))
{
if (DECL_BY_DESCRIPTOR_P (gnu_stub_param))
- gnu_param = convert_vms_descriptor (TREE_VALUE (gnu_arg_types),
- gnu_stub_param, gnat_subprog);
+ gnu_param
+ = convert_vms_descriptor (TREE_VALUE (gnu_arg_types),
+ gnu_stub_param,
+ DECL_PARM_ALT_TYPE (gnu_stub_param),
+ gnat_subprog);
else
gnu_param = gnu_stub_param;
@@ -3644,31 +3869,31 @@ update_pointer_to (tree old_type, tree new_type)
}
}
-/* Convert a pointer to a constrained array into a pointer to a fat
- pointer. This involves making or finding a template. */
+/* Convert EXPR, a pointer to a constrained array, into a pointer to an
+ unconstrained one. This involves making or finding a template. */
static tree
convert_to_fat_pointer (tree type, tree expr)
{
tree template_type = TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type))));
- tree template, template_addr;
+ tree p_array_type = TREE_TYPE (TYPE_FIELDS (type));
tree etype = TREE_TYPE (expr);
+ tree template;
- /* If EXPR is a constant of zero, we make a fat pointer that has a null
- pointer to the template and array. */
+ /* If EXPR is null, make a fat pointer that contains null pointers to the
+ template and array. */
if (integer_zerop (expr))
return
gnat_build_constructor
(type,
tree_cons (TYPE_FIELDS (type),
- convert (TREE_TYPE (TYPE_FIELDS (type)), expr),
+ convert (p_array_type, expr),
tree_cons (TREE_CHAIN (TYPE_FIELDS (type)),
convert (build_pointer_type (template_type),
expr),
NULL_TREE)));
- /* If EXPR is a thin pointer, make the template and data from the record. */
-
+ /* If EXPR is a thin pointer, make template and data from the record.. */
else if (TYPE_THIN_POINTER_P (etype))
{
tree fields = TYPE_FIELDS (TREE_TYPE (etype));
@@ -3684,30 +3909,31 @@ convert_to_fat_pointer (tree type, tree expr)
build_component_ref (expr, NULL_TREE,
TREE_CHAIN (fields), false));
}
+
+ /* Otherwise, build the constructor for the template. */
else
- /* Otherwise, build the constructor for the template. */
template = build_template (template_type, TREE_TYPE (etype), expr);
- template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template);
+ /* The final result is a constructor for the fat pointer.
- /* The result is a CONSTRUCTOR for the fat pointer.
-
- If expr is an argument of a foreign convention subprogram, the type it
- points to is directly the component type. In this case, the expression
+ If EXPR is an argument of a foreign convention subprogram, the type it
+ points to is directly the component type. In this case, the expression
type may not match the corresponding FIELD_DECL type at this point, so we
- call "convert" here to fix that up if necessary. This type consistency is
+ call "convert" here to fix that up if necessary. This type consistency is
required, for instance because it ensures that possible later folding of
- component_refs against this constructor always yields something of the
+ COMPONENT_REFs against this constructor always yields something of the
same type as the initial reference.
- Note that the call to "build_template" above is still fine, because it
- will only refer to the provided template_type in this case. */
- return
- gnat_build_constructor
- (type, tree_cons (TYPE_FIELDS (type),
- convert (TREE_TYPE (TYPE_FIELDS (type)), expr),
- tree_cons (TREE_CHAIN (TYPE_FIELDS (type)),
- template_addr, NULL_TREE)));
+ Note that the call to "build_template" above is still fine because it
+ will only refer to the provided TEMPLATE_TYPE in this case. */
+ return
+ gnat_build_constructor
+ (type,
+ tree_cons (TYPE_FIELDS (type),
+ convert (p_array_type, expr),
+ tree_cons (TREE_CHAIN (TYPE_FIELDS (type)),
+ build_unary_op (ADDR_EXPR, NULL_TREE, template),
+ NULL_TREE)));
}
/* Convert to a thin pointer type, TYPE. The only thing we know how to convert
@@ -4035,9 +4261,6 @@ convert (tree type, tree expr)
case VOID_TYPE:
return fold_build1 (CONVERT_EXPR, type, expr);
- case BOOLEAN_TYPE:
- return fold_convert (type, gnat_truthvalue_conversion (expr));
-
case INTEGER_TYPE:
if (TYPE_HAS_ACTUAL_BOUNDS_P (type)
&& (ecode == ARRAY_TYPE || ecode == UNCONSTRAINED_ARRAY_TYPE
@@ -4052,6 +4275,7 @@ convert (tree type, tree expr)
/* ... fall through ... */
case ENUMERAL_TYPE:
+ case BOOLEAN_TYPE:
/* If we are converting an additive expression to an integer type
with lower precision, be wary of the optimization that can be
applied by convert_to_integer. There are 2 problematic cases:
diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c
index 1ed1b9f9cdb..1424ac8649a 100644
--- a/gcc/ada/gcc-interface/utils2.c
+++ b/gcc/ada/gcc-interface/utils2.c
@@ -2156,37 +2156,13 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
alternate 64bit descriptor. */
tree
-fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual)
+fill_vms_descriptor (tree expr, Entity_Id gnat_formal)
{
tree field;
tree parm_decl = get_gnu_tree (gnat_formal);
tree const_list = NULL_TREE;
- int size;
tree record_type;
- /* A string literal will always be in 32bit space on VMS. Where
- will it be on other 64bit systems???
- An identifier's allocation may be unknown at compile time.
- An explicit dereference could be either in 32bit or 64bit space.
- Don't know about other possibilities, so assume unknown which
- will result in fetching the 64bit descriptor. ??? */
- if (Nkind (gnat_actual) == N_String_Literal)
- size = 32;
- else if (Nkind (gnat_actual) == N_Identifier)
- size = UI_To_Int (Esize (Etype (gnat_actual)));
- else if (Nkind (gnat_actual) == N_Explicit_Dereference)
- size = UI_To_Int (Esize (Etype (Prefix (gnat_actual))));
- else
- size = 0;
-
- /* If size is unknown, make it POINTER_SIZE */
- if (size == 0)
- size = POINTER_SIZE;
-
- /* If size is 64bits grab the alternate 64bit descriptor. */
- if (size == 64)
- TREE_TYPE (parm_decl) = DECL_PARM_ALT (parm_decl);
-
record_type = TREE_TYPE (TREE_TYPE (parm_decl));
expr = maybe_unconstrained_array (expr);
gnat_mark_addressable (expr);
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 1d875a1f3c4..29c1aec6dae 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -1829,6 +1829,7 @@ MECHANISM_NAME ::=
Value
| Reference
| Descriptor [([Class =>] CLASS_NAME)]
+| Short_Descriptor [([Class =>] CLASS_NAME)]
CLASS_NAME ::= ubs | ubsb | uba | s | sb | a
@end smallexample
@@ -1861,6 +1862,9 @@ anonymous access parameter.
@cindex OpenVMS
@cindex Passing by descriptor
Passing by descriptor is supported only on the OpenVMS ports of GNAT@.
+The default behavior for Export_Function is to accept either 64bit or
+32bit descriptors unless short_descriptor is specified, then only 32bit
+descriptors are accepted.
@cindex Suppressing external name
Special treatment is given if the EXTERNAL is an explicit null
@@ -1930,6 +1934,7 @@ MECHANISM_NAME ::=
Value
| Reference
| Descriptor [([Class =>] CLASS_NAME)]
+| Short_Descriptor [([Class =>] CLASS_NAME)]
CLASS_NAME ::= ubs | ubsb | uba | s | sb | a
@end smallexample
@@ -1947,6 +1952,9 @@ pragma that specifies the desired foreign convention.
@cindex OpenVMS
@cindex Passing by descriptor
Passing by descriptor is supported only on the OpenVMS ports of GNAT@.
+The default behavior for Export_Procedure is to accept either 64bit or
+32bit descriptors unless short_descriptor is specified, then only 32bit
+descriptors are accepted.
@cindex Suppressing external name
Special treatment is given if the EXTERNAL is an explicit null
@@ -2012,6 +2020,7 @@ MECHANISM_NAME ::=
Value
| Reference
| Descriptor [([Class =>] CLASS_NAME)]
+| Short_Descriptor [([Class =>] CLASS_NAME)]
CLASS_NAME ::= ubs | ubsb | uba | s | sb | a
@end smallexample
@@ -2034,6 +2043,9 @@ pragma that specifies the desired foreign convention.
@cindex OpenVMS
@cindex Passing by descriptor
Passing by descriptor is supported only on the OpenVMS ports of GNAT@.
+The default behavior for Export_Valued_Procedure is to accept either 64bit or
+32bit descriptors unless short_descriptor is specified, then only 32bit
+descriptors are accepted.
@cindex Suppressing external name
Special treatment is given if the EXTERNAL is an explicit null
@@ -2460,6 +2472,7 @@ MECHANISM_NAME ::=
Value
| Reference
| Descriptor [([Class =>] CLASS_NAME)]
+| Short_Descriptor [([Class =>] CLASS_NAME)]
CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
@end smallexample
@@ -2493,6 +2506,8 @@ is used.
@cindex OpenVMS
@cindex Passing by descriptor
Passing by descriptor is supported only on the OpenVMS ports of GNAT@.
+The default behavior for Import_Function is to pass a 64bit descriptor
+unless short_descriptor is specified, then a 32bit descriptor is passed.
@code{First_Optional_Parameter} applies only to OpenVMS ports of GNAT@.
It specifies that the designated parameter and all following parameters
@@ -2566,6 +2581,7 @@ MECHANISM_NAME ::=
Value
| Reference
| Descriptor [([Class =>] CLASS_NAME)]
+| Short_Descriptor [([Class =>] CLASS_NAME)]
CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
@end smallexample
@@ -2612,6 +2628,7 @@ MECHANISM_NAME ::=
Value
| Reference
| Descriptor [([Class =>] CLASS_NAME)]
+| Short_Descriptor [([Class =>] CLASS_NAME)]
CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
@end smallexample
@@ -3792,6 +3809,13 @@ package Sort is
end Sort;
@end smallexample
+@noindent
+Note: postcondition pragmas associated with subprograms that are
+marked as Inline_Always, or those marked as Inline with front-end
+inlining (-gnatN option set) are accepted and legality-checked
+by the compiler, but are ignored at run-time even if postcondition
+checking is enabled.
+
@node Pragma Precondition
@unnumberedsec Pragma Precondition
@cindex Preconditions
@@ -3826,13 +3850,22 @@ package Math_Functions is
end Math_Functions;
@end smallexample
-@code{Postcondition} pragmas may appear either immediate following the
+@noindent
+@code{Precondition} pragmas may appear either immediate following the
(separate) declaration of a subprogram, or at the start of the
declarations of a subprogram body. Only other pragmas may intervene
(that is appear between the subprogram declaration and its
postconditions, or appear before the postcondition in the
declaration sequence in a subprogram body).
+Note: postcondition pragmas associated with subprograms that are
+marked as Inline_Always, or those marked as Inline with front-end
+inlining (-gnatN option set) are accepted and legality-checked
+by the compiler, but are ignored at run-time even if postcondition
+checking is enabled.
+
+
+
@node Pragma Profile (Ravenscar)
@unnumberedsec Pragma Profile (Ravenscar)
@findex Ravenscar
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index b55f398be8a..99df83f9918 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -2368,7 +2368,7 @@ that for inlining to actually occur as a result of the use of this switch,
it is necessary to compile in optimizing mode.
@cindex @option{-gnatN} switch
-The use of @option{-gnatN} activates a more extensive inlining optimization
+The use of @option{-gnatN} activates inlining optimization
that is performed by the front end of the compiler. This inlining does
not require that the code generation be optimized. Like @option{-gnatn},
the use of this switch generates additional dependencies.
@@ -2376,6 +2376,12 @@ Note that
@option{-gnatN} automatically implies @option{-gnatn} so it is not necessary
to specify both options.
+When using a gcc-based back end (in practice this means using any version
+of GNAT other than the JGNAT, .NET or GNAAMP versions), then the use of
+@option{-gnatN} is deprecated, and the use of @option{-gnatn} is preferred.
+Historically front end inlining was more extensive than the gcc back end
+inlining, but that is no longer the case.
+
@item
If an object file @file{O} depends on the proper body of a subunit through
inlining or instantiation, it depends on the parent unit of the subunit.
@@ -4028,11 +4034,11 @@ details.
@item -gnatq
@cindex @option{-gnatq} (@command{gcc})
-Don't quit; try semantics, even if parse errors.
+Don't quit. Try semantics, even if parse errors.
@item -gnatQ
@cindex @option{-gnatQ} (@command{gcc})
-Don't quit; generate @file{ALI} and tree files even if illegalities.
+Don't quit. Generate @file{ALI} and tree files even if illegalities.
@item -gnatr
@cindex @option{-gnatr} (@command{gcc})
@@ -21535,7 +21541,7 @@ The control structures checked are the following:
@end itemize
@noindent
-The rule may have the following parameter for the @option{+R} option:
+The rule has the following parameter for the @option{+R} option:
@table @emph
@item N
@@ -21544,18 +21550,12 @@ level that is not flagged
@end table
@noindent
-If the parameter for the @option{+R} option is not a positive integer,
-the parameter is ignored and the rule is turned ON with the most recently
-specified maximal non-flagged nesting level.
+If the parameter for the @option{+R} option is not specified or
+if it is not a positive integer, @option{+R} option is ignored.
If more then one option is specified for the gnatcheck call, the later option and
new parameter override the previous one(s).
-A @option{+R} option with no parameter turns the rule ON using the maximal
-non-flagged nesting level specified by the most recent @option{+R} option with
-a parameter, or the value 4 if there is no such previous @option{+R} option.
-
-
@node Parameters_Out_Of_Order
@subsection @code{Parameters_Out_Of_Order}
@@ -25508,6 +25508,7 @@ information about several specific platforms.
* Linux-Specific Considerations::
* AIX-Specific Considerations::
* Irix-Specific Considerations::
+* RTX-Specific Considerations::
@end menu
@node Summary of Run-Time Configurations
@@ -25618,6 +25619,15 @@ information about several specific platforms.
@item @code{@ @ @ @ }Tasking @tab native Win32 threads
@item @code{@ @ @ @ }Exceptions @tab SJLJ
@*
+@item @b{x86-windows-rtx}
+@item @code{@ @ }@i{rts-rtx-rtss (default)}
+@item @code{@ @ @ @ }Tasking @tab RTX real-time subsystem RTSS threads (kernel mode)
+@item @code{@ @ @ @ }Exceptions @tab SJLJ
+@*
+@item @code{@ @ }@i{rts-rtx-w32}
+@item @code{@ @ @ @ }Tasking @tab RTX Win32 threads (user mode)
+@item @code{@ @ @ @ }Exceptions @tab ZCX
+@*
@item @b{x86_64-linux}
@item @code{@ @ }@i{rts-native (default)}
@item @code{@ @ @ @ }Tasking @tab pthread library
@@ -25842,6 +25852,26 @@ $ LD_LIBRARY_PATH=$LD_LIBRARY_PATH:`dirname \`gcc --print-file-name=libgcc_s.so
@end group
@end smallexample
+@node RTX-Specific Considerations
+@section RTX-Specific Considerations
+@cindex RTX libraries
+
+@noindent
+The Real-time Extension (RTX) to Windows is based on the Windows Win32
+API. Applications can be built to work in two different modes:
+
+@itemize @bullet
+@item
+Windows executables that run in Ring 3 to utilize memory protection
+(@emph{rts-rtx-w32}).
+
+@item
+Real-time subsystem (RTSS) executables that run in Ring 0, where
+performance can be optimized with RTSS applications taking precedent
+over all Windows applications (@emph{rts-rtx-rtss}).
+
+@end itemize
+
@c *******************************
@node Example of Binder Output File
@appendix Example of Binder Output File
diff --git a/gcc/ada/gnatchop.adb b/gcc/ada/gnatchop.adb
index 766a474afbf..7c17beb5802 100644
--- a/gcc/ada/gnatchop.adb
+++ b/gcc/ada/gnatchop.adb
@@ -63,9 +63,9 @@ procedure Gnatchop is
-- Arguments used in Gnat_Cmd call
EOF : constant Character := Character'Val (26);
- -- Special character to signal end of file. Not required in input
- -- files, but properly treated if present. Not generated in output
- -- files except as a result of copying input file.
+ -- Special character to signal end of file. Not required in input files,
+ -- but properly treated if present. Not generated in output files except
+ -- as a result of copying input file.
--------------------
-- File arguments --
@@ -152,8 +152,8 @@ procedure Gnatchop is
-- Index of unit in sorted unit list
Bufferg : String_Access;
- -- Pointer to buffer containing configuration pragmas to be
- -- prepended. Null if no pragmas to be prepended.
+ -- Pointer to buffer containing configuration pragmas to be prepended.
+ -- Null if no pragmas to be prepended.
end record;
-- The following table stores the unit offset information
@@ -1018,9 +1018,9 @@ procedure Gnatchop is
Contents := new String (1 .. Read_Ptr);
Contents.all := Buffer (1 .. Read_Ptr);
- -- Things aren't simple on VMS due to the plethora of file types
- -- and organizations. It seems clear that there shouldn't be more
- -- bytes read than are contained in the file though.
+ -- Things aren't simple on VMS due to the plethora of file types and
+ -- organizations. It seems clear that there shouldn't be more bytes
+ -- read than are contained in the file though.
if Hostparm.OpenVMS then
Success := Read_Ptr <= Length + 1;
@@ -1249,7 +1249,6 @@ procedure Gnatchop is
F : constant String := File.Table (File_Num).Name.all;
begin
-
if Is_Directory (F) then
Error_Msg (F & " is a directory, cannot be chopped");
return False;
@@ -1277,7 +1276,6 @@ procedure Gnatchop is
end if;
return False;
-
end Scan_Arguments;
----------------
@@ -1636,11 +1634,11 @@ procedure Gnatchop is
-- Returns in OS_Name the proper name for the OS when used with the
-- returned Encoding value. For example on Windows this will return the
-- UTF-8 encoded name into OS_Name and set Encoding to encoding=utf8
- -- (form parameter Stream_IO).
+ -- (the form parameter for Stream_IO).
+ --
-- Name is the filename and W_Name the same filename in Unicode 16 bits
- -- (this corresponds to Win32 Unicode ISO/IEC 10646). N_Length and
- -- E_Length are the length returned in OS_Name and Encoding
- -- respectively.
+ -- (this corresponds to Win32 Unicode ISO/IEC 10646). N_Length/E_Length
+ -- are the length returned in OS_Name/Encoding respectively.
Info : Unit_Info renames Unit.Table (Num);
Name : aliased constant String := Info.File_Name.all & ASCII.NUL;
@@ -1676,6 +1674,7 @@ procedure Gnatchop is
C_Name : aliased constant String := E_Name & ASCII.NUL;
OS_Encoding : constant String := Encoding (1 .. E_Length);
File : Stream_IO.File_Type;
+
begin
begin
if not Overwrite_Files and then Exists (E_Name) then
@@ -1685,6 +1684,7 @@ procedure Gnatchop is
(File, Stream_IO.Out_File, E_Name, OS_Encoding);
Success := True;
end if;
+
exception
when Stream_IO.Name_Error | Stream_IO.Use_Error =>
Error_Msg ("cannot create " & Info.File_Name.all);
@@ -1705,7 +1705,6 @@ procedure Gnatchop is
if Success and then Info.Bufferg /= null then
Write_Source_Reference_Pragma (Info, 1, File, EOL, Success);
-
String'Write (Stream_IO.Stream (File), Info.Bufferg.all);
end if;
@@ -1742,10 +1741,9 @@ procedure Gnatchop is
-- Start of processing for gnatchop
begin
- -- Add the directory where gnatchop is invoked in front of the
- -- path, if gnatchop is invoked with directory information.
- -- Only do this if the platform is not VMS, where the notion of path
- -- does not really exist.
+ -- Add the directory where gnatchop is invoked in front of the path, if
+ -- gnatchop is invoked with directory information. Only do this if the
+ -- platform is not VMS, where the notion of path does not really exist.
if not Hostparm.OpenVMS then
declare
@@ -1758,12 +1756,10 @@ begin
Absolute_Dir : constant String :=
Normalize_Pathname
(Command (Command'First .. Index));
-
PATH : constant String :=
- Absolute_Dir &
- Path_Separator &
- Getenv ("PATH").all;
-
+ Absolute_Dir
+ & Path_Separator
+ & Getenv ("PATH").all;
begin
Setenv ("PATH", PATH);
end;
@@ -1813,26 +1809,24 @@ begin
Sort_Units;
- -- Check if any duplicate files would be created. If so, emit
- -- a warning if Overwrite_Files is true, otherwise generate an error.
+ -- Check if any duplicate files would be created. If so, emit a warning if
+ -- Overwrite_Files is true, otherwise generate an error.
if Report_Duplicate_Units and then not Overwrite_Files then
goto No_Files_Written;
end if;
- -- Check if any files exist, if so do not write anything
- -- Because all files have been parsed and checked already,
- -- there won't be any duplicates
+ -- Check if any files exist, if so do not write anything Because all files
+ -- have been parsed and checked already, there won't be any duplicates
if not Overwrite_Files and then Files_Exist then
goto No_Files_Written;
end if;
- -- After this point, all source files are read in succession
- -- and chopped into their destination files.
+ -- After this point, all source files are read in succession and chopped
+ -- into their destination files.
- -- As the Source_File_Name pragmas are handled as logical file 0,
- -- write it first.
+ -- Source_File_Name pragmas are handled as logical file 0 so write it first
for F in 1 .. File.Last loop
if not Write_Chopped_Files (F) then
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index 24a6437f26b..47fc71e6fff 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -102,6 +102,7 @@ int __gl_zero_cost_exceptions = 0;
int __gl_detect_blocking = 0;
int __gl_default_stack_size = -1;
int __gl_leap_seconds_support = 0;
+int __gl_canonical_streams = 0;
/* Indication of whether synchronous signal handler has already been
installed by a previous call to adainit. */
diff --git a/gcc/ada/ioexcept.ads b/gcc/ada/ioexcept.ads
index 0473ff32bdf..efdadc713c9 100644
--- a/gcc/ada/ioexcept.ads
+++ b/gcc/ada/ioexcept.ads
@@ -15,9 +15,9 @@
pragma Ada_2005;
-- Explicit setting of Ada 2005 mode is required here, since we want to with a
--- child unit (not possible in Ada 83 mode), and Text_IO is not considered to
--- be an internal unit that is automatically compiled in Ada 2005 mode (since
--- a user is allowed to redeclare IO_Exceptions).
+-- child unit (not possible in Ada 83 mode), and IO_Exceptions is not
+-- considered to be an internal unit that is automatically compiled in Ada
+-- 2005 mode (since a user is allowed to redeclare IO_Exceptions).
with Ada.IO_Exceptions;
diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index 8af553fef59..2ab83c53aa8 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -1834,7 +1834,11 @@ package body Lib.Xref is
Par : Node_Id;
begin
- if Ekind (Scope (E)) /= E_Generic_Package then
+ -- The Present check here is an error defense
+
+ if Present (Scope (E))
+ and then Ekind (Scope (E)) /= E_Generic_Package
+ then
return False;
end if;
diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb
index 1755ade229c..3d0ee62eaed 100644
--- a/gcc/ada/makeutl.adb
+++ b/gcc/ada/makeutl.adb
@@ -246,7 +246,15 @@ package body Makeutl is
-- If we get here, the user has typed the executable name with no
-- directory prefix.
- return Get_Install_Dir (Locate_Exec_On_Path (Exec_Name).all);
+ declare
+ Path : constant String_Access := Locate_Exec_On_Path (Exec_Name);
+ begin
+ if Path = null then
+ return "";
+ else
+ return Get_Install_Dir (Path.all);
+ end if;
+ end;
end Executable_Prefix_Path;
----------
diff --git a/gcc/ada/mlib-tgt-specific-vms-alpha.adb b/gcc/ada/mlib-tgt-specific-vms-alpha.adb
index 291293607f9..f272307b935 100644
--- a/gcc/ada/mlib-tgt-specific-vms-alpha.adb
+++ b/gcc/ada/mlib-tgt-specific-vms-alpha.adb
@@ -276,12 +276,26 @@ package body MLib.Tgt.Specific is
-- Create and write the auto-init assembly file
declare
- First_Line : constant String :=
- ASCII.HT & ".section LIB$INITIALIZE,GBL,NOWRT" &
- ASCII.LF;
- Second_Line : constant String :=
- ASCII.HT & ".long " & Init_Proc & ASCII.LF;
- -- First and second lines of the auto-init assembly file
+ use ASCII;
+
+ -- Output a dummy transfer address for debugging
+ -- followed by the LIB$INITIALIZE section.
+
+ Lines : constant String :=
+ HT & ".text" & LF &
+ HT & ".align 4" & LF &
+ HT & ".globl __main" & LF &
+ HT & ".ent __main" & LF &
+ "__main..en:" & LF &
+ HT & ".base $27" & LF &
+ HT & ".frame $29,0,$26,8" & LF &
+ HT & "ret $31,($26),1" & LF &
+ HT & ".link" & LF &
+ "__main:" & LF &
+ HT & ".pdesc __main..en,null" & LF &
+ HT & ".end __main" & LF & LF &
+ HT & ".section LIB$INITIALIZE,GBL,NOWRT" & LF &
+ HT & ".long " & Init_Proc & LF;
begin
Macro_File := Create_File (Macro_File_Name, Text);
@@ -289,16 +303,9 @@ package body MLib.Tgt.Specific is
if OK then
Len := Write
- (Macro_File, First_Line (First_Line'First)'Address,
- First_Line'Length);
- OK := Len = First_Line'Length;
- end if;
-
- if OK then
- Len := Write
- (Macro_File, Second_Line (Second_Line'First)'Address,
- Second_Line'Length);
- OK := Len = Second_Line'Length;
+ (Macro_File, Lines (Lines'First)'Address,
+ Lines'Length);
+ OK := Len = Lines'Length;
end if;
if OK then
diff --git a/gcc/ada/mlib-tgt-specific-vms-ia64.adb b/gcc/ada/mlib-tgt-specific-vms-ia64.adb
index baa8ce213f1..ed483876be4 100644
--- a/gcc/ada/mlib-tgt-specific-vms-ia64.adb
+++ b/gcc/ada/mlib-tgt-specific-vms-ia64.adb
@@ -275,26 +275,30 @@ package body MLib.Tgt.Specific is
-- Create and write the auto-init assembly file
declare
- First_Line : constant String :=
- ASCII.HT
- & ".type " & Init_Proc & "#, @function"
- & ASCII.LF;
- Second_Line : constant String :=
- ASCII.HT
- & ".global " & Init_Proc & "#"
- & ASCII.LF;
- Third_Line : constant String :=
- ASCII.HT
- & ".global LIB$INITIALIZE#"
- & ASCII.LF;
- Fourth_Line : constant String :=
- ASCII.HT
- & ".section LIB$INITIALIZE#,""a"",@progbits"
- & ASCII.LF;
- Fifth_Line : constant String :=
- ASCII.HT
- & "data4 @fptr(" & Init_Proc & "#)"
- & ASCII.LF;
+ use ASCII;
+
+ -- Output a dummy transfer address for debugging
+ -- followed by the LIB$INITIALIZE section.
+
+ Lines : constant String :=
+ HT & ".pred.safe_across_calls p1-p5,p16-p63" & LF &
+ HT & ".text" & LF &
+ HT & ".align 16" & LF &
+ HT & ".global __main#" & LF &
+ HT & ".proc __main#" & LF &
+ "__main:" & LF &
+ HT & ".prologue" & LF &
+ HT & ".body" & LF &
+ HT & ".mib" & LF &
+ HT & "nop 0" & LF &
+ HT & "nop 0" & LF &
+ HT & "br.ret.sptk.many b0" & LF &
+ HT & ".endp __main#" & LF & LF &
+ HT & ".type " & Init_Proc & "#, @function" & LF &
+ HT & ".global " & Init_Proc & "#" & LF &
+ HT & ".global LIB$INITIALIZE#" & LF &
+ HT & ".section LIB$INITIALIZE#,""a"",@progbits" & LF &
+ HT & "data4 @fptr(" & Init_Proc & "#)" & LF;
begin
Macro_File := Create_File (Macro_File_Name, Text);
@@ -302,37 +306,9 @@ package body MLib.Tgt.Specific is
if OK then
Len := Write
- (Macro_File, First_Line (First_Line'First)'Address,
- First_Line'Length);
- OK := Len = First_Line'Length;
- end if;
-
- if OK then
- Len := Write
- (Macro_File, Second_Line (Second_Line'First)'Address,
- Second_Line'Length);
- OK := Len = Second_Line'Length;
- end if;
-
- if OK then
- Len := Write
- (Macro_File, Third_Line (Third_Line'First)'Address,
- Third_Line'Length);
- OK := Len = Third_Line'Length;
- end if;
-
- if OK then
- Len := Write
- (Macro_File, Fourth_Line (Fourth_Line'First)'Address,
- Fourth_Line'Length);
- OK := Len = Fourth_Line'Length;
- end if;
-
- if OK then
- Len := Write
- (Macro_File, Fifth_Line (Fifth_Line'First)'Address,
- Fifth_Line'Length);
- OK := Len = Fifth_Line'Length;
+ (Macro_File, Lines (Lines'First)'Address,
+ Lines'Length);
+ OK := Len = Lines'Length;
end if;
if OK then
diff --git a/gcc/ada/mlib-utl.adb b/gcc/ada/mlib-utl.adb
index 4d15ad85cf3..76e7db5332b 100644
--- a/gcc/ada/mlib-utl.adb
+++ b/gcc/ada/mlib-utl.adb
@@ -35,6 +35,10 @@ with System;
package body MLib.Utl is
+ Adalib_Path : String_Access := null;
+ -- Path of the GNAT adalib directory, specified in procedure
+ -- Specify_Adalib_Dir. Used in function Lib_Directory.
+
Gcc_Name : String_Access;
-- Default value of the "gcc" executable used in procedure Gcc
@@ -597,6 +601,13 @@ package body MLib.Utl is
Libgnat : constant String := Tgt.Libgnat;
begin
+ -- If procedure Specify_Adalib_Dir has been called, used the specified
+ -- value.
+
+ if Adalib_Path /= null then
+ return Adalib_Path.all;
+ end if;
+
Name_Len := Libgnat'Length;
Name_Buffer (1 .. Name_Len) := Libgnat;
Get_Name_String (Osint.Find_File (Name_Enter, Osint.Library));
@@ -606,4 +617,17 @@ package body MLib.Utl is
return Name_Buffer (1 .. Name_Len - Libgnat'Length);
end Lib_Directory;
+ ------------------------
+ -- Specify_Adalib_Dir --
+ ------------------------
+
+ procedure Specify_Adalib_Dir (Path : String) is
+ begin
+ if Path'Length = 0 then
+ Adalib_Path := null;
+ else
+ Adalib_Path := new String'(Path);
+ end if;
+ end Specify_Adalib_Dir;
+
end MLib.Utl;
diff --git a/gcc/ada/mlib-utl.ads b/gcc/ada/mlib-utl.ads
index fc5894f70e2..f91eebf7f51 100644
--- a/gcc/ada/mlib-utl.ads
+++ b/gcc/ada/mlib-utl.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2007, AdaCore --
+-- Copyright (C) 2001-2008, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -47,12 +47,21 @@ package MLib.Utl is
procedure Ar
(Output_File : String;
Objects : Argument_List);
- -- Run ar to move all the binaries inside the archive. If ranlib is on the
- -- path, run it also. Output_File is the path name of the archive to
+ -- Run ar to move all the binaries inside the archive. If ranlib is on
+ -- the path, run it also. Output_File is the path name of the archive to
-- create. Objects is the list of the path names of the object files to be
- -- put in the archive.
+ -- put in the archive. This procedure currently assumes that it is always
+ -- called in the context of gnatmake. If other executables start using this
+ -- procedure, an additional parameter would need to be added, and calls to
+ -- Osint.Program_Name updated accordingly in the body.
function Lib_Directory return String;
-- Return the directory containing libgnat
+ procedure Specify_Adalib_Dir (Path : String);
+ -- Specify the path of the GNAT adalib directory, to be returned by
+ -- function Lib_Directory without looking for it. This is used only in
+ -- gprlib, because we cannot rely on the search in Lib_Directory, as the
+ -- GNAT version may be different for gprbuild/gprlib and the compiler.
+
end MLib.Utl;
diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index c2ec59be9dc..9a5a8d39345 100644
--- a/gcc/ada/par-ch3.adb
+++ b/gcc/ada/par-ch3.adb
@@ -206,6 +206,18 @@ package body Ch3 is
Ident_Node := Token_Node;
Scan; -- past the reserved identifier
+ -- If we already have a defining identifier, clean it out and make
+ -- a new clean identifier. This situation arises in some error cases
+ -- and we need to fix it.
+
+ if Nkind (Ident_Node) = N_Defining_Identifier then
+ Ident_Node :=
+ Make_Identifier (Sloc (Ident_Node),
+ Chars => Chars (Ident_Node));
+ end if;
+
+ -- Change identifier to defining identifier if not in error
+
if Ident_Node /= Error then
Change_Identifier_To_Defining_Identifier (Ident_Node);
end if;
@@ -290,20 +302,12 @@ package body Ch3 is
Scan; -- past TYPE
Ident_Node := P_Defining_Identifier (C_Is);
- -- Otherwise this is an error case, and we may already have converted
- -- the current token to a defining identifier, so don't do it again!
+ -- Otherwise this is an error case
else
T_Type;
-
- if Token = Tok_Identifier
- and then Nkind (Token_Node) = N_Defining_Identifier
- then
- Ident_Node := Token_Node;
- Scan; -- past defining identifier
- else
- Ident_Node := P_Defining_Identifier (C_Is);
- end if;
+ Type_Token_Location := Type_Loc;
+ Ident_Node := P_Defining_Identifier (C_Is);
end if;
Discr_Sloc := Token_Ptr;
@@ -1356,7 +1360,6 @@ package body Ch3 is
-- If we have a comma, then scan out the list of identifiers
elsif Token = Tok_Comma then
-
while Comma_Present loop
Num_Idents := Num_Idents + 1;
Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index c8b84ab189e..ba32f387b6a 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -1032,6 +1032,10 @@ begin
raise Constraint_Error;
end if;
+ Upper_Half_Encoding :=
+ Wide_Character_Encoding_Method in
+ WC_Upper_Half_Encoding_Method;
+
exception
when Constraint_Error =>
Error_Msg_N ("invalid argument for pragma%", Arg1);
diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb
index 6f6c888b4e6..3421ac1cd70 100644
--- a/gcc/ada/prj-attr.adb
+++ b/gcc/ada/prj-attr.adb
@@ -168,6 +168,7 @@ package body Prj.Attr is
"Sadriver#" &
"Larequired_switches#" &
"Lapic_option#" &
+ "Sapath_syntax#" &
-- Configuration - Mapping files
diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb
index dd52f353287..1744716342d 100644
--- a/gcc/ada/prj-env.adb
+++ b/gcc/ada/prj-env.adb
@@ -2353,18 +2353,38 @@ package body Prj.Env is
(Data.Object_Directory.Name, In_Tree);
end if;
- -- For a non-library project, add the object
- -- directory, if it is not a virtual project, and if
- -- there are Ada sources or if the project is an
- -- extending project. If there are no Ada sources,
- -- adding the object directory could disrupt the order
- -- of the object dirs in the path.
-
- elsif not Data.Virtual
- and then There_Are_Ada_Sources (In_Tree, Project)
- then
- Add_To_Object_Path
- (Data.Object_Directory.Name, In_Tree);
+ -- For a non-library project, add object directory if
+ -- it is not a virtual project, and if there are Ada
+ -- sources in the project or one of the projects it
+ -- extends. If there are no Ada sources, adding the
+ -- object directory could disrupt the order of the
+ -- object dirs in the path.
+
+ elsif not Data.Virtual then
+ declare
+ Add_Object_Dir : Boolean := False;
+ Prj : Project_Id := Project;
+
+ begin
+ while not Add_Object_Dir
+ and then Prj /= No_Project
+ loop
+ if In_Tree.Projects.Table
+ (Prj).Ada_Sources /= Nil_String
+ then
+ Add_Object_Dir := True;
+
+ else
+ Prj :=
+ In_Tree.Projects.Table (Prj).Extends;
+ end if;
+ end loop;
+
+ if Add_Object_Dir then
+ Add_To_Object_Path
+ (Data.Object_Directory.Name, In_Tree);
+ end if;
+ end;
end if;
end if;
end if;
diff --git a/gcc/ada/prj-makr.ads b/gcc/ada/prj-makr.ads
index 50a97e93b51..b3a658fc3e9 100644
--- a/gcc/ada/prj-makr.ads
+++ b/gcc/ada/prj-makr.ads
@@ -73,6 +73,11 @@ package Prj.Makr is
-- check for non Ada sources.
--
-- At least one of Name_Patterns and Foreign_Patterns is not empty
+ --
+ -- Note that this procedure currently assumes that it is only used by
+ -- gnatname. If other processes start using it, then an additional
+ -- parameter would need to be added, and call to Osint.Program_Name
+ -- updated accordingly in the body.
procedure Finalize;
-- Write the configuration pragmas file or the project file indicated in a
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index d84ba7fbbf7..b3dc949347c 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -65,9 +65,6 @@ package body Prj.Nmsc is
ALI_Suffix : constant String := ".ali";
-- File suffix for ali files
- Object_Suffix : constant String := Get_Target_Object_Suffix.all;
- -- File suffix for object files
-
type Name_Location is record
Name : File_Name_Type;
Location : Source_Ptr;
@@ -267,20 +264,6 @@ package body Prj.Nmsc is
Data : in out Project_Data);
-- Check the configuration attributes for the project
- procedure Check_For_Source
- (File_Name : File_Name_Type;
- Path_Name : Path_Name_Type;
- Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
- Location : Source_Ptr;
- Language : Language_Index;
- Suffix : String;
- Naming_Exception : Boolean);
- -- Check if a file, with name File_Name and path Path_Name, in a source
- -- directory is a source for language Language in project Project of
- -- project tree In_Tree. ???
-
procedure Check_If_Externally_Built
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
@@ -369,15 +352,6 @@ package body Prj.Nmsc is
-- Current_Dir should represent the current directory, and is passed for
-- efficiency to avoid system calls to recompute it.
- procedure Find_Sources
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
- For_Language : Language_Index;
- Current_Dir : String);
- -- Find all the sources in all of the source directories of a project for
- -- a specified language.
-
procedure Search_Directories
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
@@ -467,8 +441,7 @@ package body Prj.Nmsc is
-- Source_Names.
procedure Find_Explicit_Sources
- (Lang : Language_Index;
- Current_Dir : String;
+ (Current_Dir : String;
Project : Project_Id;
In_Tree : Project_Tree_Ref;
Data : in out Project_Data);
@@ -566,16 +539,6 @@ package body Prj.Nmsc is
-- Current_Dir should represent the current directory, and is passed for
-- efficiency to avoid system calls to recompute it.
- procedure Record_Other_Sources
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
- Language : Language_Index;
- Naming_Exceptions : Boolean);
- -- Record the sources of a language in a project. When Naming_Exceptions is
- -- True, mark the found sources as such, to later remove those that are not
- -- named in a list of sources.
-
procedure Remove_Source
(Id : Source_Id;
Replaced_By : Source_Id;
@@ -597,13 +560,6 @@ package body Prj.Nmsc is
(Data : Project_Data; In_Tree : Project_Tree_Ref);
-- List all the source directories of a project
- function Suffix_For
- (Language : Language_Index;
- Naming : Naming_Data;
- In_Tree : Project_Tree_Ref) return File_Name_Type;
- -- Get the suffix for the source of a language from a package naming. If
- -- not specified, return the default for the language.
-
procedure Warn_If_Not_Sources
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
@@ -1486,7 +1442,7 @@ package body Prj.Nmsc is
then
In_Tree.Languages_Data.Table
(Lang_Index).Config.Dependency_Kind :=
- Makefile;
+ Makefile;
end if;
List := Element.Value.Values;
@@ -1525,7 +1481,7 @@ package body Prj.Nmsc is
In_Tree.Languages_Data.Table
(Lang_Index).Config.Include_Path :=
- Element.Value.Value;
+ Element.Value.Value;
when Name_Include_Path_File =>
@@ -1533,7 +1489,7 @@ package body Prj.Nmsc is
In_Tree.Languages_Data.Table
(Lang_Index).Config.Include_Path_File :=
- Element.Value.Value;
+ Element.Value.Value;
when Name_Driver =>
@@ -1543,16 +1499,32 @@ package body Prj.Nmsc is
In_Tree.Languages_Data.Table
(Lang_Index).Config.Compiler_Driver :=
- File_Name_Type (Element.Value.Value);
+ File_Name_Type (Element.Value.Value);
when Name_Required_Switches =>
Put (Into_List =>
- In_Tree.Languages_Data.Table
- (Lang_Index).Config.
- Compiler_Required_Switches,
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.
+ Compiler_Required_Switches,
From_List => Element.Value.Values,
In_Tree => In_Tree);
+ when Name_Path_Syntax =>
+ begin
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Path_Syntax :=
+ Path_Syntax_Kind'Value
+ (Get_Name_String (Element.Value.Value));
+
+ exception
+ when Constraint_Error =>
+ Error_Msg
+ (Project,
+ In_Tree,
+ "invalid value for Path_Syntax",
+ Element.Value.Location);
+ end;
+
when Name_Pic_Option =>
-- Attribute Compiler_Pic_Option (<language>)
@@ -1624,8 +1596,8 @@ package body Prj.Nmsc is
end if;
Put (Into_List =>
- In_Tree.Languages_Data.Table
- (Lang_Index).Config.Config_File_Switches,
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Config_File_Switches,
From_List => List,
In_Tree => In_Tree);
@@ -1635,7 +1607,7 @@ package body Prj.Nmsc is
In_Tree.Languages_Data.Table
(Lang_Index).Config.Objects_Path :=
- Element.Value.Value;
+ Element.Value.Value;
when Name_Objects_Path_File =>
@@ -1643,7 +1615,7 @@ package body Prj.Nmsc is
In_Tree.Languages_Data.Table
(Lang_Index).Config.Objects_Path_File :=
- Element.Value.Value;
+ Element.Value.Value;
when Name_Config_Body_File_Name =>
@@ -1651,7 +1623,7 @@ package body Prj.Nmsc is
In_Tree.Languages_Data.Table
(Lang_Index).Config.Config_Body :=
- Element.Value.Value;
+ Element.Value.Value;
when Name_Config_Body_File_Name_Pattern =>
@@ -1668,7 +1640,7 @@ package body Prj.Nmsc is
In_Tree.Languages_Data.Table
(Lang_Index).Config.Config_Spec :=
- Element.Value.Value;
+ Element.Value.Value;
when Name_Config_Spec_File_Name_Pattern =>
@@ -1722,8 +1694,7 @@ package body Prj.Nmsc is
Attribute_Id := Attributes;
while Attribute_Id /= No_Variable loop
- Attribute :=
- In_Tree.Variable_Elements.Table (Attribute_Id);
+ Attribute := In_Tree.Variable_Elements.Table (Attribute_Id);
if not Attribute.Value.Default then
if Attribute.Name = Name_Separate_Suffix then
@@ -2449,287 +2420,6 @@ package body Prj.Nmsc is
end loop;
end Check_Configuration;
- ----------------------
- -- Check_For_Source --
- ----------------------
-
- procedure Check_For_Source
- (File_Name : File_Name_Type;
- Path_Name : Path_Name_Type;
- Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
- Location : Source_Ptr;
- Language : Language_Index;
- Suffix : String;
- Naming_Exception : Boolean)
- is
- Name : String := Get_Name_String (File_Name);
- Real_Location : Source_Ptr := Location;
-
- begin
- Canonical_Case_File_Name (Name);
-
- -- A file is a source of a language if Naming_Exception is True (case
- -- of naming exceptions) or if its file name ends with the suffix.
-
- if Naming_Exception
- or else
- (Name'Length > Suffix'Length
- and then
- Name (Name'Last - Suffix'Length + 1 .. Name'Last) = Suffix)
- then
- if Real_Location = No_Location then
- Real_Location := Data.Location;
- end if;
-
- declare
- Path_Id : Path_Name_Type;
- C_Path_Id : Path_Name_Type;
- -- The path name id (in canonical case)
-
- File_Id : File_Name_Type;
- -- The file name id (in canonical case)
-
- Obj_Id : File_Name_Type;
- -- The object file name
-
- Obj_Path_Id : Path_Name_Type;
- -- The object path name
-
- Dep_Id : File_Name_Type;
- -- The dependency file name
-
- Dep_Path_Id : Path_Name_Type;
- -- The dependency path name
-
- Dot_Pos : Natural := 0;
- -- Position of the last dot in Name
-
- Source : Other_Source;
- Source_Id : Other_Source_Id := Data.First_Other_Source;
-
- begin
- -- Get the file name id
-
- if Osint.File_Names_Case_Sensitive then
- File_Id := File_Name;
- else
- Name_Len := Name'Length;
- Name_Buffer (1 .. Name_Len) := Name;
- File_Id := Name_Find;
- end if;
-
- -- Get the path name id
-
- Path_Id := Path_Name;
-
- if Osint.File_Names_Case_Sensitive then
- C_Path_Id := Path_Name;
- else
- declare
- C_Path : String := Get_Name_String (Path_Name);
- begin
- Canonical_Case_File_Name (C_Path);
- Name_Len := C_Path'Length;
- Name_Buffer (1 .. Name_Len) := C_Path;
- C_Path_Id := Name_Find;
- end;
- end if;
-
- -- Find the position of the last dot
-
- for J in reverse Name'Range loop
- if Name (J) = '.' then
- Dot_Pos := J;
- exit;
- end if;
- end loop;
-
- if Dot_Pos <= Name'First then
- Dot_Pos := Name'Last + 1;
- end if;
-
- -- Compute the object file name
-
- Get_Name_String (File_Id);
- Name_Len := Dot_Pos - Name'First;
-
- for J in Object_Suffix'Range loop
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := Object_Suffix (J);
- end loop;
-
- Obj_Id := Name_Find;
-
- -- Compute the object path name
-
- Get_Name_String (Data.Object_Directory.Display_Name);
-
- if Name_Buffer (Name_Len) /= Directory_Separator
- and then Name_Buffer (Name_Len) /= '/'
- then
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := Directory_Separator;
- end if;
-
- Add_Str_To_Name_Buffer (Get_Name_String (Obj_Id));
- Obj_Path_Id := Name_Find;
-
- -- Compute the dependency file name
-
- Get_Name_String (File_Id);
- Name_Len := Dot_Pos - Name'First + 1;
- Name_Buffer (Name_Len) := '.';
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := 'd';
- Dep_Id := Name_Find;
-
- -- Compute the dependency path name
-
- Get_Name_String (Data.Object_Directory.Display_Name);
-
- if Name_Buffer (Name_Len) /= Directory_Separator
- and then Name_Buffer (Name_Len) /= '/'
- then
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := Directory_Separator;
- end if;
-
- Add_Str_To_Name_Buffer (Get_Name_String (Dep_Id));
- Dep_Path_Id := Name_Find;
-
- -- Check if source is already in the list of source for this
- -- project: it may have already been specified as a naming
- -- exception for the same language or an other language, or
- -- they may be two identical file names in different source
- -- directories.
-
- while Source_Id /= No_Other_Source loop
- Source := In_Tree.Other_Sources.Table (Source_Id);
-
- if Source.File_Name = File_Id then
- -- Two sources of different languages cannot have the same
- -- file name.
-
- if Source.Language /= Language then
- Error_Msg_File_1 := File_Name;
- Error_Msg
- (Project, In_Tree,
- "{ cannot be a source of several languages",
- Real_Location);
- return;
-
- -- No problem if a file has already been specified as
- -- a naming exception of this language.
-
- elsif Source.Path_Name = C_Path_Id then
-
- -- Reset the naming exception flag, if this is not a
- -- naming exception.
-
- if not Naming_Exception then
- In_Tree.Other_Sources.Table
- (Source_Id).Naming_Exception := False;
- end if;
-
- return;
-
- -- There are several files with the same names, but the
- -- order of the source directories is known (no /**):
- -- only the first one encountered is kept, the other ones
- -- are ignored.
-
- elsif Data.Known_Order_Of_Source_Dirs then
- return;
-
- -- But it is an error if the order of the source directories
- -- is not known.
-
- else
- Error_Msg_File_1 := File_Name;
- Error_Msg
- (Project, In_Tree,
- "{ is found in several source directories",
- Real_Location);
- return;
- end if;
-
- -- Two sources with different file names cannot have the same
- -- object file name.
-
- elsif Source.Object_Name = Obj_Id then
- Error_Msg_File_1 := File_Id;
- Error_Msg_File_2 := Source.File_Name;
- Error_Msg_File_3 := Obj_Id;
- Error_Msg
- (Project, In_Tree,
- "{ and { have the same object file {",
- Real_Location);
- return;
- end if;
-
- Source_Id := Source.Next;
- end loop;
-
- if Current_Verbosity = High then
- Write_Str (" found ");
- Display_Language_Name (Language);
- Write_Str (" source """);
- Write_Str (Get_Name_String (File_Name));
- Write_Line ("""");
- Write_Str (" object path = ");
- Write_Line (Get_Name_String (Obj_Path_Id));
- end if;
-
- -- Create the Other_Source record
-
- Source :=
- (Language => Language,
- File_Name => File_Id,
- Path_Name => Path_Id,
- Source_TS => File_Stamp (Path_Id),
- Object_Name => Obj_Id,
- Object_Path => Obj_Path_Id,
- Object_TS => File_Stamp (Obj_Path_Id),
- Dep_Name => Dep_Id,
- Dep_Path => Dep_Path_Id,
- Dep_TS => File_Stamp (Dep_Path_Id),
- Naming_Exception => Naming_Exception,
- Next => No_Other_Source);
-
- -- And add it to the Other_Sources table
-
- Other_Source_Table.Increment_Last (In_Tree.Other_Sources);
- In_Tree.Other_Sources.Table
- (Other_Source_Table.Last (In_Tree.Other_Sources)) := Source;
-
- -- There are sources of languages other than Ada in this project
-
- Data.Other_Sources_Present := True;
-
- -- And there are sources of this language in this project
-
- Set (Language, True, Data, In_Tree);
-
- -- Add this source to the list of sources of languages other than
- -- Ada of the project.
-
- if Data.First_Other_Source = No_Other_Source then
- Data.First_Other_Source :=
- Other_Source_Table.Last (In_Tree.Other_Sources);
-
- else
- In_Tree.Other_Sources.Table (Data.Last_Other_Source).Next :=
- Other_Source_Table.Last (In_Tree.Other_Sources);
- end if;
-
- Data.Last_Other_Source :=
- Other_Source_Table.Last (In_Tree.Other_Sources);
- end;
- end if;
- end Check_For_Source;
-
-------------------------------
-- Check_If_Externally_Built --
-------------------------------
@@ -4429,6 +4119,47 @@ package body Prj.Nmsc is
end if;
end if;
+ -- Check if Linker'Switches or Linker'Default_Switches are declared.
+ -- Warn if they are declared, as it is a common error to think that
+ -- library are "linked" with Linker switches.
+
+ if Data.Library then
+ declare
+ Linker_Package_Id : constant Package_Id :=
+ Util.Value_Of
+ (Name_Linker, Data.Decl.Packages, In_Tree);
+ Linker_Package : Package_Element;
+ Switches : Array_Element_Id := No_Array_Element;
+
+ begin
+ if Linker_Package_Id /= No_Package then
+ Linker_Package := In_Tree.Packages.Table (Linker_Package_Id);
+
+ Switches :=
+ Value_Of
+ (Name => Name_Switches,
+ In_Arrays => Linker_Package.Decl.Arrays,
+ In_Tree => In_Tree);
+
+ if Switches = No_Array_Element then
+ Switches :=
+ Value_Of
+ (Name => Name_Default_Switches,
+ In_Arrays => Linker_Package.Decl.Arrays,
+ In_Tree => In_Tree);
+ end if;
+
+ if Switches /= No_Array_Element then
+ Error_Msg
+ (Project, In_Tree,
+ "?Linker switches not taken into account in library " &
+ "projects",
+ No_Location);
+ end if;
+ end if;
+ end;
+ end if;
+
if Data.Extends /= No_Project then
In_Tree.Projects.Table (Data.Extends).Library := False;
end if;
@@ -4683,11 +4414,8 @@ package body Prj.Nmsc is
(Name => Name_Ada, Next => No_Name_List);
-- Attribute Languages is not specified. So, it defaults to
- -- a project of language Ada only.
-
- Data.Langs (Ada_Language_Index) := True;
-
- -- No sources of languages other than Ada
+ -- a project of language Ada only. No sources of languages
+ -- other than Ada
Data.Other_Sources_Present := False;
@@ -4757,13 +4485,10 @@ package body Prj.Nmsc is
NL_Id : Name_List_Index := No_Name_List;
begin
- if Get_Mode = Ada_Only then
+ -- Assume there are no language declared
- -- Assume that there is no language specified yet
-
- Data.Other_Sources_Present := False;
- Data.Ada_Sources_Present := False;
- end if;
+ Data.Ada_Sources_Present := False;
+ Data.Other_Sources_Present := False;
-- If there are no languages declared, there are no sources
@@ -4820,21 +4545,9 @@ package body Prj.Nmsc is
(Lang_Name, No_Name_List);
if Get_Mode = Ada_Only then
- Index := Language_Indexes.Get (Lang_Name);
+ -- Check for language Ada
- if Index = No_Language_Index then
- Add_Language_Name (Lang_Name);
- Index := Last_Language_Index;
- end if;
-
- Set (Index, True, Data, In_Tree);
- Set (Language_Processing =>
- Default_Language_Processing_Data,
- For_Language => Index,
- In_Project => Data,
- In_Tree => In_Tree);
-
- if Index = Ada_Language_Index then
+ if Lang_Name = Name_Ada then
Data.Ada_Sources_Present := True;
else
@@ -5936,155 +5649,6 @@ package body Prj.Nmsc is
end Find_Ada_Sources;
- ------------------
- -- Find_Sources --
- ------------------
-
- procedure Find_Sources
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
- For_Language : Language_Index;
- Current_Dir : String)
- is
- Source_Dir : String_List_Id;
- Element : String_Element;
- Dir : Dir_Type;
- Current_Source : String_List_Id := Nil_String;
- Source_Recorded : Boolean := False;
-
- begin
- if Current_Verbosity = High then
- Write_Line ("Looking for sources:");
- end if;
-
- -- Loop through subdirectories
-
- Source_Dir := Data.Source_Dirs;
- while Source_Dir /= Nil_String loop
- begin
- Source_Recorded := False;
- Element := In_Tree.String_Elements.Table (Source_Dir);
-
- if Element.Value /= No_Name then
- Get_Name_String (Element.Display_Value);
-
- declare
- Source_Directory : constant String :=
- Name_Buffer (1 .. Name_Len) &
- Directory_Separator;
-
- Dir_Last : constant Natural :=
- Compute_Directory_Last (Source_Directory);
-
- begin
- if Current_Verbosity = High then
- Write_Str ("Source_Dir = ");
- Write_Line (Source_Directory);
- end if;
-
- -- We look to every entry in the source directory
-
- Open (Dir, Source_Directory
- (Source_Directory'First .. Dir_Last));
-
- loop
- Read (Dir, Name_Buffer, Name_Len);
-
- if Current_Verbosity = High then
- Write_Str (" Checking ");
- Write_Line (Name_Buffer (1 .. Name_Len));
- end if;
-
- exit when Name_Len = 0;
-
- declare
- File_Name : constant File_Name_Type := Name_Find;
- Path : constant String :=
- Normalize_Pathname
- (Name => Name_Buffer (1 .. Name_Len),
- Directory => Source_Directory
- (Source_Directory'First .. Dir_Last),
- Resolve_Links => Opt.Follow_Links_For_Files,
- Case_Sensitive => True);
- Path_Name : Path_Name_Type;
-
- begin
- Name_Len := Path'Length;
- Name_Buffer (1 .. Name_Len) := Path;
- Path_Name := Name_Find;
-
- if For_Language = Ada_Language_Index then
-
- -- We attempt to register it as a source. However,
- -- there is no error if the file does not contain
- -- a valid source. But there is an error if we have
- -- a duplicate unit name.
-
- Record_Ada_Source
- (File_Name => File_Name,
- Path_Name => Path_Name,
- Project => Project,
- In_Tree => In_Tree,
- Data => Data,
- Location => No_Location,
- Current_Source => Current_Source,
- Source_Recorded => Source_Recorded,
- Current_Dir => Current_Dir);
-
- else
- Check_For_Source
- (File_Name => File_Name,
- Path_Name => Path_Name,
- Project => Project,
- In_Tree => In_Tree,
- Data => Data,
- Location => No_Location,
- Language => For_Language,
- Suffix =>
- Body_Suffix_Of (For_Language, Data, In_Tree),
- Naming_Exception => False);
- end if;
- end;
- end loop;
-
- Close (Dir);
- end;
- end if;
-
- exception
- when Directory_Error =>
- null;
- end;
-
- if Source_Recorded then
- In_Tree.String_Elements.Table (Source_Dir).Flag :=
- True;
- end if;
-
- Source_Dir := Element.Next;
- end loop;
-
- if Current_Verbosity = High then
- Write_Line ("end Looking for sources.");
- end if;
-
- if For_Language = Ada_Language_Index then
-
- -- If we have looked for sources and found none, then it is an error,
- -- except if it is an extending project. If a non extending project
- -- is not supposed to contain any source files, then never call
- -- Find_Sources.
-
- if Current_Source /= Nil_String then
- Data.Ada_Sources_Present := True;
-
- elsif Data.Extends = No_Project then
- Report_No_Sources (Project, "Ada", In_Tree, Data.Location);
- end if;
- end if;
- end Find_Sources;
-
--------------------------------
-- Free_Ada_Naming_Exceptions --
--------------------------------
@@ -6556,7 +6120,7 @@ package body Prj.Nmsc is
-- We set the object directory to its default
- Data.Object_Directory := Data.Directory;
+ Data.Object_Directory := Data.Directory;
if Object_Dir.Value /= Empty_String then
Get_Name_String (Object_Dir.Value);
@@ -6621,7 +6185,7 @@ package body Prj.Nmsc is
(Project,
In_Tree,
Name_Find,
- Data.Directory.Name,
+ Data.Directory.Display_Name,
Data.Object_Directory.Name,
Data.Object_Directory.Display_Name,
Create => "object",
@@ -6664,7 +6228,7 @@ package body Prj.Nmsc is
(Project,
In_Tree,
File_Name_Type (Exec_Dir.Value),
- Data.Directory.Name,
+ Data.Directory.Display_Name,
Data.Exec_Directory.Name,
Data.Exec_Directory.Display_Name,
Create => "exec",
@@ -6762,7 +6326,7 @@ package body Prj.Nmsc is
Data.Object_Directory := No_Path_Information;
end if;
- Data.Source_Dirs := Nil_String;
+ Data.Source_Dirs := Nil_String;
else
declare
@@ -6774,8 +6338,7 @@ package body Prj.Nmsc is
Source_Dir := Source_Dirs.Values;
while Source_Dir /= Nil_String loop
- Element :=
- In_Tree.String_Elements.Table (Source_Dir);
+ Element := In_Tree.String_Elements.Table (Source_Dir);
Find_Source_Dirs
(File_Name_Type (Element.Value), Element.Location);
Source_Dir := Element.Next;
@@ -6795,8 +6358,7 @@ package body Prj.Nmsc is
Source_Dir := Excluded_Source_Dirs.Values;
while Source_Dir /= Nil_String loop
- Element :=
- In_Tree.String_Elements.Table (Source_Dir);
+ Element := In_Tree.String_Elements.Table (Source_Dir);
Find_Source_Dirs
(File_Name_Type (Element.Value),
Element.Location,
@@ -6900,6 +6462,7 @@ package body Prj.Nmsc is
if not Prj.Util.Is_Valid (File) then
Error_Msg (Project, In_Tree, "file does not exist", Location);
+
else
-- Read the lines one by one
@@ -7005,9 +6568,9 @@ package body Prj.Nmsc is
Last : Natural := File'Last;
Standard_GNAT : Boolean;
Spec : constant File_Name_Type :=
- Spec_Suffix_Id_Of (In_Tree, Name_Ada, Naming);
+ Spec_Suffix_Id_Of (In_Tree, Name_Ada, Naming);
Body_Suff : constant File_Name_Type :=
- Body_Suffix_Id_Of (In_Tree, Name_Ada, Naming);
+ Body_Suffix_Id_Of (In_Tree, Name_Ada, Naming);
begin
Standard_GNAT := Spec = Default_Ada_Spec_Suffix
@@ -7606,8 +7169,7 @@ package body Prj.Nmsc is
---------------------------
procedure Find_Explicit_Sources
- (Lang : Language_Index;
- Current_Dir : String;
+ (Current_Dir : String;
Project : Project_Id;
In_Tree : Project_Tree_Ref;
Data : in out Project_Data)
@@ -7654,18 +7216,9 @@ package body Prj.Nmsc is
Data.Ada_Sources_Present := Current /= Nil_String;
end if;
- -- If we are processing other languages in the case of gprmake,
- -- we should not reset the list of sources, which was already
- -- initialized for the Ada files.
-
- if Get_Mode /= Ada_Only or else Lang /= Ada_Language_Index then
+ if Get_Mode = Multi_Language then
if Current = Nil_String then
- case Get_Mode is
- when Ada_Only =>
- Data.Source_Dirs := Nil_String;
- when Multi_Language =>
- Data.First_Language_Processing := No_Language_Index;
- end case;
+ Data.First_Language_Processing := No_Language_Index;
-- This project contains no source. For projects that
-- don't extend other projects, this also means that
@@ -7743,17 +7296,8 @@ package body Prj.Nmsc is
end loop;
if Get_Mode = Ada_Only then
- if Lang = Ada_Language_Index then
- Get_Path_Names_And_Record_Ada_Sources
- (Project, In_Tree, Data, Current_Dir);
- else
- Record_Other_Sources
- (Project => Project,
- In_Tree => In_Tree,
- Data => Data,
- Language => Lang,
- Naming_Exceptions => False);
- end if;
+ Get_Path_Names_And_Record_Ada_Sources
+ (Project, In_Tree, Data, Current_Dir);
end if;
end;
@@ -7787,18 +7331,8 @@ package body Prj.Nmsc is
if Get_Mode = Ada_Only then
-- Look in the source directories to find those sources
- if Lang = Ada_Language_Index then
- Get_Path_Names_And_Record_Ada_Sources
- (Project, In_Tree, Data, Current_Dir);
-
- else
- Record_Other_Sources
- (Project => Project,
- In_Tree => In_Tree,
- Data => Data,
- Language => Lang,
- Naming_Exceptions => False);
- end if;
+ Get_Path_Names_And_Record_Ada_Sources
+ (Project, In_Tree, Data, Current_Dir);
end if;
end if;
end;
@@ -7808,22 +7342,9 @@ package body Prj.Nmsc is
-- specified. Find all the files that satisfy the naming
-- scheme in all the source directories.
- case Get_Mode is
- when Ada_Only =>
- if Lang = Ada_Language_Index then
- Find_Ada_Sources (Project, In_Tree, Data, Current_Dir);
- else
- -- Find all the files that satisfy the naming scheme in
- -- all the source directories. All the naming exceptions
- -- that effectively exist are also part of the source
- -- of this language.
-
- Find_Sources (Project, In_Tree, Data, Lang, Current_Dir);
- end if;
-
- when Multi_Language =>
- null;
- end case;
+ if Get_Mode = Ada_Only then
+ Find_Ada_Sources (Project, In_Tree, Data, Current_Dir);
+ end if;
end if;
if Get_Mode = Multi_Language then
@@ -7888,7 +7409,6 @@ package body Prj.Nmsc is
end if;
if Get_Mode = Ada_Only
- and then Lang = Ada_Language_Index
and then Data.Extends = No_Project
then
-- We should have found at least one source, if not report an error
@@ -8829,9 +8349,6 @@ package body Prj.Nmsc is
procedure Remove_Locally_Removed_Files_From_Units;
-- Mark all locally removed sources as such in the Units table
- procedure Process_Other_Sources_In_Ada_Only_Mode;
- -- Find sources for language other than Ada when in Ada_Only mode
-
procedure Process_Sources_In_Multi_Language_Mode;
-- Find all source files when in multi language mode
@@ -8896,116 +8413,6 @@ package body Prj.Nmsc is
end Remove_Locally_Removed_Files_From_Units;
--------------------------------------------
- -- Process_Other_Sources_In_Ada_Only_Mode --
- --------------------------------------------
-
- procedure Process_Other_Sources_In_Ada_Only_Mode is
- begin
- -- Set Source_Present to False. It will be set back to True
- -- whenever a source is found.
-
- Data.Other_Sources_Present := False;
- for Lang in Ada_Language_Index + 1 .. Last_Language_Index loop
-
- -- For each language (other than Ada) in the project file
-
- if Is_Present (Lang, Data, In_Tree) then
-
- -- Reset the indication that there are sources of this
- -- language. It will be set back to True whenever we find
- -- a source of the language.
-
- Set (Lang, False, Data, In_Tree);
-
- -- First, get the source suffix for the language
-
- Set (Suffix => Suffix_For (Lang, Data.Naming, In_Tree),
- For_Language => Lang,
- In_Project => Data,
- In_Tree => In_Tree);
-
- -- Then, deal with the naming exceptions, if any
-
- Source_Names.Reset;
-
- declare
- Naming_Exceptions : constant Variable_Value :=
- Value_Of
- (Index => Language_Names.Table (Lang),
- Src_Index => 0,
- In_Array => Data.Naming.Implementation_Exceptions,
- In_Tree => In_Tree);
- Element_Id : String_List_Id;
- Element : String_Element;
- File_Id : File_Name_Type;
- Source_Found : Boolean := False;
-
- begin
- -- If there are naming exceptions, look through them one
- -- by one.
-
- if Naming_Exceptions /= Nil_Variable_Value then
- Element_Id := Naming_Exceptions.Values;
-
- while Element_Id /= Nil_String loop
- Element := In_Tree.String_Elements.Table (Element_Id);
-
- if Osint.File_Names_Case_Sensitive then
- File_Id := File_Name_Type (Element.Value);
- else
- Get_Name_String (Element.Value);
- Canonical_Case_File_Name
- (Name_Buffer (1 .. Name_Len));
- File_Id := Name_Find;
- end if;
-
- -- Put each naming exception in the Source_Names hash
- -- table, but if there are repetition, don't bother
- -- after the first instance.
-
- if Source_Names.Get (File_Id) = No_Name_Location then
- Source_Found := True;
- Source_Names.Set
- (File_Id,
- (Name => File_Id,
- Location => Element.Location,
- Source => No_Source,
- Except => False,
- Found => False));
- end if;
-
- Element_Id := Element.Next;
- end loop;
-
- -- If there is at least one naming exception, record
- -- those that are found in the source directories.
-
- if Source_Found then
- Record_Other_Sources
- (Project => Project,
- In_Tree => In_Tree,
- Data => Data,
- Language => Lang,
- Naming_Exceptions => True);
- end if;
-
- end if;
- end;
-
- -- Now, check if a list of sources is declared either through
- -- a string list (attribute Source_Files) or a text file
- -- (attribute Source_List_File). If a source list is declared,
- -- we will consider only those naming exceptions that are
- -- on the list.
-
- Source_Names.Reset;
- Find_Explicit_Sources
- (Lang, Current_Dir, Project, In_Tree, Data);
- end if;
- end loop;
- end Process_Other_Sources_In_Ada_Only_Mode;
-
- --------------------------------------------
-- Process_Sources_In_Multi_Language_Mode --
--------------------------------------------
@@ -9077,7 +8484,7 @@ package body Prj.Nmsc is
end loop;
Find_Explicit_Sources
- (Ada_Language_Index, Current_Dir, Project, In_Tree, Data);
+ (Current_Dir, Project, In_Tree, Data);
-- Mark as such the sources that are declared as excluded
@@ -9219,15 +8626,10 @@ package body Prj.Nmsc is
case Get_Mode is
when Ada_Only =>
if Is_A_Language (In_Tree, Data, Name_Ada) then
- Find_Explicit_Sources
- (Ada_Language_Index, Current_Dir, Project, In_Tree, Data);
+ Find_Explicit_Sources (Current_Dir, Project, In_Tree, Data);
Remove_Locally_Removed_Files_From_Units;
end if;
- if Data.Other_Sources_Present then
- Process_Other_Sources_In_Ada_Only_Mode;
- end if;
-
when Multi_Language =>
if Data.First_Language_Processing /= No_Language_Index then
Process_Sources_In_Multi_Language_Mode;
@@ -9456,7 +8858,6 @@ package body Prj.Nmsc is
if Current_Source = Nil_String then
Data.Ada_Sources :=
String_Element_Table.Last (In_Tree.String_Elements);
- Data.Sources := Data.Ada_Sources;
else
In_Tree.String_Elements.Table (Current_Source).Next :=
String_Element_Table.Last (In_Tree.String_Elements);
@@ -9531,7 +8932,6 @@ package body Prj.Nmsc is
then
if Previous_Source = Nil_String then
Data.Ada_Sources := Nil_String;
- Data.Sources := Nil_String;
else
In_Tree.String_Elements.Table (Previous_Source).Next :=
Nil_String;
@@ -9624,179 +9024,6 @@ package body Prj.Nmsc is
end if;
end Record_Ada_Source;
- --------------------------
- -- Record_Other_Sources --
- --------------------------
-
- procedure Record_Other_Sources
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
- Language : Language_Index;
- Naming_Exceptions : Boolean)
- is
- Source_Dir : String_List_Id;
- Element : String_Element;
- Path : Path_Name_Type;
- Dir : Dir_Type;
- Canonical_Name : File_Name_Type;
- Name_Str : String (1 .. 1_024);
- Last : Natural := 0;
- NL : Name_Location;
- First_Error : Boolean := True;
- Suffix : constant String :=
- Body_Suffix_Of (Language, Data, In_Tree);
-
- begin
- Source_Dir := Data.Source_Dirs;
- while Source_Dir /= Nil_String loop
- Element := In_Tree.String_Elements.Table (Source_Dir);
-
- declare
- Dir_Path : constant String :=
- Get_Name_String (Element.Display_Value);
- begin
- if Current_Verbosity = High then
- Write_Str ("checking directory """);
- Write_Str (Dir_Path);
- Write_Str (""" for ");
-
- if Naming_Exceptions then
- Write_Str ("naming exceptions");
- else
- Write_Str ("sources");
- end if;
-
- Write_Str (" of Language ");
- Display_Language_Name (Language);
- end if;
-
- Open (Dir, Dir_Path);
-
- loop
- Read (Dir, Name_Str, Last);
- exit when Last = 0;
-
- if Is_Regular_File
- (Dir_Path & Directory_Separator & Name_Str (1 .. Last))
- then
- Name_Len := Last;
- Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Canonical_Name := Name_Find;
- NL := Source_Names.Get (Canonical_Name);
-
- if NL /= No_Name_Location then
- if NL.Found then
- if not Data.Known_Order_Of_Source_Dirs then
- Error_Msg_File_1 := Canonical_Name;
- Error_Msg
- (Project, In_Tree,
- "{ is found in several source directories",
- NL.Location);
- end if;
-
- else
- NL.Found := True;
- Source_Names.Set (Canonical_Name, NL);
- Name_Len := Dir_Path'Length;
- Name_Buffer (1 .. Name_Len) := Dir_Path;
- Add_Char_To_Name_Buffer (Directory_Separator);
- Add_Str_To_Name_Buffer (Name_Str (1 .. Last));
- Path := Name_Find;
-
- Check_For_Source
- (File_Name => Canonical_Name,
- Path_Name => Path,
- Project => Project,
- In_Tree => In_Tree,
- Data => Data,
- Location => NL.Location,
- Language => Language,
- Suffix => Suffix,
- Naming_Exception => Naming_Exceptions);
- end if;
- end if;
- end if;
- end loop;
-
- Close (Dir);
- end;
-
- Source_Dir := Element.Next;
- end loop;
-
- if not Naming_Exceptions then
- NL := Source_Names.Get_First;
-
- -- It is an error if a source file name in a source list or
- -- in a source list file is not found.
-
- while NL /= No_Name_Location loop
- if not NL.Found then
- Err_Vars.Error_Msg_File_1 := NL.Name;
-
- if First_Error then
- Error_Msg
- (Project, In_Tree, "source file { cannot be found",
- NL.Location);
- First_Error := False;
-
- else
- Error_Msg
- (Project, In_Tree, "\source file { cannot be found",
- NL.Location);
- end if;
- end if;
-
- NL := Source_Names.Get_Next;
- end loop;
-
- -- Any naming exception of this language that is not in a list
- -- of sources must be removed.
-
- declare
- Source_Id : Other_Source_Id;
- Prev_Id : Other_Source_Id;
- Source : Other_Source;
-
- begin
- Prev_Id := No_Other_Source;
- Source_Id := Data.First_Other_Source;
- while Source_Id /= No_Other_Source loop
- Source := In_Tree.Other_Sources.Table (Source_Id);
-
- if Source.Language = Language
- and then Source.Naming_Exception
- then
- if Current_Verbosity = High then
- Write_Str ("Naming exception """);
- Write_Str (Get_Name_String (Source.File_Name));
- Write_Str (""" is not in the list of sources,");
- Write_Line (" so it is removed.");
- end if;
-
- if Prev_Id = No_Other_Source then
- Data.First_Other_Source := Source.Next;
- else
- In_Tree.Other_Sources.Table (Prev_Id).Next := Source.Next;
- end if;
-
- Source_Id := Source.Next;
-
- if Source_Id = No_Other_Source then
- Data.Last_Other_Source := Prev_Id;
- end if;
-
- else
- Prev_Id := Source_Id;
- Source_Id := Source.Next;
- end if;
- end loop;
- end;
- end if;
- end Record_Other_Sources;
-
-------------------
-- Remove_Source --
-------------------
@@ -9971,52 +9198,6 @@ package body Prj.Nmsc is
Write_Line ("end Source_Dirs.");
end Show_Source_Dirs;
- ----------------
- -- Suffix_For --
- ----------------
-
- function Suffix_For
- (Language : Language_Index;
- Naming : Naming_Data;
- In_Tree : Project_Tree_Ref) return File_Name_Type
- is
- Suffix : constant Variable_Value :=
- Value_Of
- (Index => Language_Names.Table (Language),
- Src_Index => 0,
- In_Array => Naming.Body_Suffix,
- In_Tree => In_Tree);
-
- begin
- -- If no suffix for this language in package Naming, use the default
-
- if Suffix = Nil_Variable_Value then
- Name_Len := 0;
-
- case Language is
- when Ada_Language_Index =>
- Add_Str_To_Name_Buffer (".adb");
-
- when C_Language_Index =>
- Add_Str_To_Name_Buffer (".c");
-
- when C_Plus_Plus_Language_Index =>
- Add_Str_To_Name_Buffer (".cpp");
-
- when others =>
- return No_File;
- end case;
-
- -- Otherwise use the one specified
-
- else
- Get_Name_String (Suffix.Value);
- end if;
-
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- return Name_Find;
- end Suffix_For;
-
-------------------------
-- Warn_If_Not_Sources --
-------------------------
diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb
index 67c913378dd..5e0b14f0151 100644
--- a/gcc/ada/prj-part.adb
+++ b/gcc/ada/prj-part.adb
@@ -149,6 +149,29 @@ package body Prj.Part is
-- does not (because it is already extended), but other projects that it
-- imports may need to be virtually extended.
+ type Extension_Origin is (None, Extending_Simple, Extending_All);
+ -- Type of parameter From_Extended for procedures Parse_Single_Project and
+ -- Post_Parse_Context_Clause. Extending_All means that we are parsing the
+ -- tree rooted at an extending all project.
+
+ procedure Parse_Single_Project
+ (In_Tree : Project_Node_Tree_Ref;
+ Project : out Project_Node_Id;
+ Extends_All : out Boolean;
+ Path_Name : String;
+ Extended : Boolean;
+ From_Extended : Extension_Origin;
+ In_Limited : Boolean;
+ Packages_To_Check : String_List_Access;
+ Depth : Natural;
+ Current_Dir : String);
+ -- Parse a project file. This is a recursive procedure: it calls itself for
+ -- imported and extended projects. When From_Extended is not None, if the
+ -- project has already been parsed and is an extended project A, return the
+ -- ultimate (not extended) project that extends A. When In_Limited is True,
+ -- the importing path includes at least one "limited with". When parsing
+ -- configuration projects, do not allow a depth > 1.
+
procedure Pre_Parse_Context_Clause
(In_Tree : Project_Node_Tree_Ref;
Context_Clause : out With_Id);
diff --git a/gcc/ada/prj-part.ads b/gcc/ada/prj-part.ads
index 8e366bc4fff..e1c69c5ab83 100644
--- a/gcc/ada/prj-part.ads
+++ b/gcc/ada/prj-part.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2008, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -49,28 +49,4 @@ package Prj.Part is
-- Current_Directory is used for optimization purposes only, avoiding extra
-- system calls.
- type Extension_Origin is (None, Extending_Simple, Extending_All);
- -- Type of parameter From_Extended for procedures Parse_Single_Project and
- -- Post_Parse_Context_Clause. Extending_All means that we are parsing the
- -- tree rooted at an extending all project.
-
- procedure Parse_Single_Project
- (In_Tree : Project_Node_Tree_Ref;
- Project : out Project_Node_Id;
- Extends_All : out Boolean;
- Path_Name : String;
- Extended : Boolean;
- From_Extended : Extension_Origin;
- In_Limited : Boolean;
- Packages_To_Check : String_List_Access;
- Depth : Natural;
- Current_Dir : String);
- -- Parse a project file.
- -- Recursive procedure: it calls itself for imported and extended
- -- projects. When From_Extended is not None, if the project has already
- -- been parsed and is an extended project A, return the ultimate
- -- (not extended) project that extends A. When In_Limited is True,
- -- the importing path includes at least one "limited with".
- -- When parsing configuration projects, do not allow a depth > 1.
-
end Prj.Part;
diff --git a/gcc/ada/prj-util.ads b/gcc/ada/prj-util.ads
index e2a9558e5eb..0efdfbb5b03 100644
--- a/gcc/ada/prj-util.ads
+++ b/gcc/ada/prj-util.ads
@@ -146,14 +146,14 @@ package Prj.Util is
-- the last character of each line, if possible.
type Text_File is limited private;
- -- Represents a text file. Default is invalid text file
+ -- Represents a text file (default is invalid text file)
function Is_Valid (File : Text_File) return Boolean;
- -- Returns True if File designates an open text file that
- -- has not yet been closed.
+ -- Returns True if File designates an open text file that has not yet been
+ -- closed.
procedure Open (File : out Text_File; Name : String);
- -- Open a text file. If this procedure fails, File is invalid
+ -- Open a text file to read (file is invalid if text file cannot be opened)
function End_Of_File (File : Text_File) return Boolean;
-- Returns True if the end of the text file File has been reached. Fails if
@@ -163,7 +163,7 @@ package Prj.Util is
(File : Text_File;
Line : out String;
Last : out Natural);
- -- Reads a line from an open text file. Fails if File is invalid
+ -- Reads a line from an open text file (fails if file is invalid)
procedure Close (File : in out Text_File);
-- Close an open text file. File becomes invalid. Fails if File is already
diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb
index d838b114442..505e2dad3d1 100644
--- a/gcc/ada/prj.adb
+++ b/gcc/ada/prj.adb
@@ -32,9 +32,11 @@ with Prj.Attr;
with Prj.Env;
with Prj.Err; use Prj.Err;
with Snames; use Snames;
+with Table;
with Uintp; use Uintp;
with System.Case_Util; use System.Case_Util;
+with System.HTable;
package body Prj is
@@ -50,8 +52,6 @@ package body Prj is
The_Empty_String : Name_Id;
- Name_C_Plus_Plus : Name_Id;
-
Default_Ada_Spec_Suffix_Id : File_Name_Type;
Default_Ada_Body_Suffix_Id : File_Name_Type;
Slash_Id : Path_Name_Type;
@@ -83,9 +83,7 @@ package body Prj is
Specs => No_Array_Element,
Bodies => No_Array_Element,
Specification_Exceptions => No_Array_Element,
- Implementation_Exceptions => No_Array_Element,
- Impl_Suffixes => No_Impl_Suffixes,
- Supp_Suffixes => No_Supp_Language_Index);
+ Implementation_Exceptions => No_Array_Element);
Project_Empty : constant Project_Data :=
(Qualifier => Unspecified,
@@ -113,8 +111,9 @@ package body Prj is
Lib_Auto_Init => False,
Libgnarl_Needed => Unknown,
Symbol_Data => No_Symbols,
+ Ada_Sources_Present => True,
+ Other_Sources_Present => True,
Ada_Sources => Nil_String,
- Sources => Nil_String,
First_Source => No_Source,
Last_Source => No_Source,
Interfaces_Defined => False,
@@ -144,25 +143,12 @@ package body Prj is
Objects_Path_File_Without_Libs => No_Path,
Config_File_Name => No_Path,
Config_File_Temp => False,
- Linker_Name => No_File,
- Linker_Path => No_Path,
- Minimum_Linker_Options => No_Name_List,
Config_Checked => False,
Checked => False,
Seen => False,
Need_To_Build_Lib => False,
Depth => 0,
- Unkept_Comments => False,
- Langs => No_Languages,
- Supp_Languages => No_Supp_Language_Index,
- Ada_Sources_Present => True,
- Other_Sources_Present => True,
- First_Other_Source => No_Other_Source,
- Last_Other_Source => No_Other_Source,
- First_Lang_Processing =>
- Default_First_Language_Processing_Data,
- Supp_Language_Processing =>
- No_Supp_Language_Index);
+ Unkept_Comments => False);
package Temp_Files is new Table.Table
(Table_Component_Type => Path_Name_Type,
@@ -174,18 +160,6 @@ package body Prj is
-- Table to store the path name of all the created temporary files, so that
-- they can be deleted at the end, or when the program is interrupted.
- -----------------------
- -- Add_Language_Name --
- -----------------------
-
- procedure Add_Language_Name (Name : Name_Id) is
- begin
- Last_Language_Index := Last_Language_Index + 1;
- Language_Indexes.Set (Name, Last_Language_Index);
- Language_Names.Increment_Last;
- Language_Names.Table (Last_Language_Index) := Name;
- end Add_Language_Name;
-
-------------------
-- Add_To_Buffer --
-------------------
@@ -341,21 +315,6 @@ package body Prj is
return "";
end Body_Suffix_Of;
- function Body_Suffix_Of
- (Language : Language_Index;
- In_Project : Project_Data;
- In_Tree : Project_Tree_Ref) return String
- is
- Suffix_Id : constant File_Name_Type :=
- Suffix_Of (Language, In_Project, In_Tree);
- begin
- if Suffix_Id /= No_File then
- return Get_Name_String (Suffix_Id);
- else
- return "." & Get_Name_String (Language_Names.Table (Language));
- end if;
- end Body_Suffix_Of;
-
-----------------------------
-- Default_Ada_Body_Suffix --
-----------------------------
@@ -430,17 +389,6 @@ package body Prj is
Write_Str (Name_Buffer (1 .. Name_Len));
end Display_Language_Name;
- ---------------------------
- -- Display_Language_Name --
- ---------------------------
-
- procedure Display_Language_Name (Language : Language_Index) is
- begin
- Get_Name_String (Language_Names.Table (Language));
- To_Upper (Name_Buffer (1 .. 1));
- Write_Str (Name_Buffer (1 .. Name_Len));
- end Display_Language_Name;
-
----------------
-- Empty_File --
----------------
@@ -638,22 +586,12 @@ package body Prj is
Name_Len := 1;
Name_Buffer (1) := '/';
Slash_Id := Name_Find;
- Name_Len := 3;
- Name_Buffer (1 .. 3) := "c++";
- Name_C_Plus_Plus := Name_Find;
Prj.Env.Initialize;
Prj.Attr.Initialize;
Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends));
Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
-
- Language_Indexes.Reset;
- Last_Language_Index := No_Language_Index;
- Language_Names.Init;
- Add_Language_Name (Name_Ada);
- Add_Language_Name (Name_C);
- Add_Language_Name (Name_C_Plus_Plus);
end if;
if Tree /= No_Project_Tree then
@@ -729,84 +667,6 @@ package body Prj is
return False;
end Is_Extending;
- ----------------
- -- Is_Present --
- ----------------
-
- function Is_Present
- (Language : Language_Index;
- In_Project : Project_Data;
- In_Tree : Project_Tree_Ref) return Boolean
- is
- begin
- case Language is
- when No_Language_Index =>
- return False;
-
- when First_Language_Indexes =>
- return In_Project.Langs (Language);
-
- when others =>
- declare
- Supp : Supp_Language;
- Supp_Index : Supp_Language_Index;
-
- begin
- Supp_Index := In_Project.Supp_Languages;
- while Supp_Index /= No_Supp_Language_Index loop
- Supp := In_Tree.Present_Languages.Table (Supp_Index);
-
- if Supp.Index = Language then
- return Supp.Present;
- end if;
-
- Supp_Index := Supp.Next;
- end loop;
-
- return False;
- end;
- end case;
- end Is_Present;
-
- ---------------------------------
- -- Language_Processing_Data_Of --
- ---------------------------------
-
- function Language_Processing_Data_Of
- (Language : Language_Index;
- In_Project : Project_Data;
- In_Tree : Project_Tree_Ref) return Language_Processing_Data
- is
- begin
- case Language is
- when No_Language_Index =>
- return Default_Language_Processing_Data;
-
- when First_Language_Indexes =>
- return In_Project.First_Lang_Processing (Language);
-
- when others =>
- declare
- Supp : Supp_Language_Data;
- Supp_Index : Supp_Language_Index;
-
- begin
- Supp_Index := In_Project.Supp_Language_Processing;
- while Supp_Index /= No_Supp_Language_Index loop
- Supp := In_Tree.Supp_Languages.Table (Supp_Index);
-
- if Supp.Index = Language then
- return Supp.Data;
- end if;
-
- Supp_Index := Supp.Next;
- end loop;
-
- return Default_Language_Processing_Data;
- end;
- end case;
- end Language_Processing_Data_Of;
-
-----------------------
-- Objects_Exist_For --
-----------------------
@@ -830,7 +690,7 @@ package body Prj is
if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
return
In_Tree.Languages_Data.Table
- (Lang).Config.Objects_Generated;
+ (Lang).Config.Object_Generated;
end if;
Lang := In_Tree.Languages_Data.Table (Lang).Next;
@@ -980,13 +840,6 @@ package body Prj is
begin
Prj.Env.Initialize;
- -- gprmake tables
-
- Present_Language_Table.Init (Tree.Present_Languages);
- Supp_Suffix_Table.Init (Tree.Supp_Suffixes);
- Supp_Language_Table.Init (Tree.Supp_Languages);
- Other_Source_Table.Init (Tree.Other_Sources);
-
-- Visible tables
Language_Data_Table.Init (Tree.Languages_Data);
@@ -1040,144 +893,6 @@ package body Prj is
and then Left.Separate_Suffix = Right.Separate_Suffix;
end Same_Naming_Scheme;
- ---------
- -- Set --
- ---------
-
- procedure Set
- (Language : Language_Index;
- Present : Boolean;
- In_Project : in out Project_Data;
- In_Tree : Project_Tree_Ref)
- is
- begin
- case Language is
- when No_Language_Index =>
- null;
-
- when First_Language_Indexes =>
- In_Project.Langs (Language) := Present;
-
- when others =>
- declare
- Supp : Supp_Language;
- Supp_Index : Supp_Language_Index;
-
- begin
- Supp_Index := In_Project.Supp_Languages;
- while Supp_Index /= No_Supp_Language_Index loop
- Supp := In_Tree.Present_Languages.Table (Supp_Index);
-
- if Supp.Index = Language then
- In_Tree.Present_Languages.Table (Supp_Index).Present :=
- Present;
- return;
- end if;
-
- Supp_Index := Supp.Next;
- end loop;
-
- Supp := (Index => Language, Present => Present,
- Next => In_Project.Supp_Languages);
- Present_Language_Table.Increment_Last
- (In_Tree.Present_Languages);
- Supp_Index :=
- Present_Language_Table.Last (In_Tree.Present_Languages);
- In_Tree.Present_Languages.Table (Supp_Index) :=
- Supp;
- In_Project.Supp_Languages := Supp_Index;
- end;
- end case;
- end Set;
-
- procedure Set
- (Language_Processing : Language_Processing_Data;
- For_Language : Language_Index;
- In_Project : in out Project_Data;
- In_Tree : Project_Tree_Ref)
- is
- begin
- case For_Language is
- when No_Language_Index =>
- null;
-
- when First_Language_Indexes =>
- In_Project.First_Lang_Processing (For_Language) :=
- Language_Processing;
-
- when others =>
- declare
- Supp : Supp_Language_Data;
- Supp_Index : Supp_Language_Index;
-
- begin
- Supp_Index := In_Project.Supp_Language_Processing;
- while Supp_Index /= No_Supp_Language_Index loop
- Supp := In_Tree.Supp_Languages.Table (Supp_Index);
-
- if Supp.Index = For_Language then
- In_Tree.Supp_Languages.Table
- (Supp_Index).Data := Language_Processing;
- return;
- end if;
-
- Supp_Index := Supp.Next;
- end loop;
-
- Supp := (Index => For_Language, Data => Language_Processing,
- Next => In_Project.Supp_Language_Processing);
- Supp_Language_Table.Increment_Last
- (In_Tree.Supp_Languages);
- Supp_Index := Supp_Language_Table.Last
- (In_Tree.Supp_Languages);
- In_Tree.Supp_Languages.Table (Supp_Index) := Supp;
- In_Project.Supp_Language_Processing := Supp_Index;
- end;
- end case;
- end Set;
-
- procedure Set
- (Suffix : File_Name_Type;
- For_Language : Language_Index;
- In_Project : in out Project_Data;
- In_Tree : Project_Tree_Ref)
- is
- begin
- case For_Language is
- when No_Language_Index =>
- null;
-
- when First_Language_Indexes =>
- In_Project.Naming.Impl_Suffixes (For_Language) := Suffix;
-
- when others =>
- declare
- Supp : Supp_Suffix;
- Supp_Index : Supp_Language_Index;
-
- begin
- Supp_Index := In_Project.Naming.Supp_Suffixes;
- while Supp_Index /= No_Supp_Language_Index loop
- Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
-
- if Supp.Index = For_Language then
- In_Tree.Supp_Suffixes.Table (Supp_Index).Suffix := Suffix;
- return;
- end if;
-
- Supp_Index := Supp.Next;
- end loop;
-
- Supp := (Index => For_Language, Suffix => Suffix,
- Next => In_Project.Naming.Supp_Suffixes);
- Supp_Suffix_Table.Increment_Last (In_Tree.Supp_Suffixes);
- Supp_Index := Supp_Suffix_Table.Last (In_Tree.Supp_Suffixes);
- In_Tree.Supp_Suffixes.Table (Supp_Index) := Supp;
- In_Project.Naming.Supp_Suffixes := Supp_Index;
- end;
- end case;
- end Set;
-
---------------------
-- Set_Body_Suffix --
---------------------
@@ -1426,45 +1141,6 @@ package body Prj is
end if;
end Standard_Naming_Data;
- ---------------
- -- Suffix_Of --
- ---------------
-
- function Suffix_Of
- (Language : Language_Index;
- In_Project : Project_Data;
- In_Tree : Project_Tree_Ref) return File_Name_Type
- is
- begin
- case Language is
- when No_Language_Index =>
- return No_File;
-
- when First_Language_Indexes =>
- return In_Project.Naming.Impl_Suffixes (Language);
-
- when others =>
- declare
- Supp : Supp_Suffix;
- Supp_Index : Supp_Language_Index;
-
- begin
- Supp_Index := In_Project.Naming.Supp_Suffixes;
- while Supp_Index /= No_Supp_Language_Index loop
- Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
-
- if Supp.Index = Language then
- return Supp.Suffix;
- end if;
-
- Supp_Index := Supp.Next;
- end loop;
-
- return No_File;
- end;
- end case;
- end Suffix_Of;
-
-------------------
-- Switches_Name --
-------------------
@@ -1476,29 +1152,6 @@ package body Prj is
return Extend_Name (Source_File_Name, Switches_Dependency_Suffix);
end Switches_Name;
- ---------------------------
- -- There_Are_Ada_Sources --
- ---------------------------
-
- function There_Are_Ada_Sources
- (In_Tree : Project_Tree_Ref;
- Project : Project_Id) return Boolean
- is
- Prj : Project_Id;
-
- begin
- Prj := Project;
- while Prj /= No_Project loop
- if In_Tree.Projects.Table (Prj).Ada_Sources /= Nil_String then
- return True;
- end if;
-
- Prj := In_Tree.Projects.Table (Prj).Extends;
- end loop;
-
- return False;
- end There_Are_Ada_Sources;
-
-----------
-- Value --
-----------
diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads
index 5d8caa79cd3..12b86b73079 100644
--- a/gcc/ada/prj.ads
+++ b/gcc/ada/prj.ads
@@ -32,15 +32,12 @@
with Casing; use Casing;
with Namet; use Namet;
with Scans; use Scans;
-with Table;
with Types; use Types;
with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
with GNAT.Dynamic_Tables;
with GNAT.OS_Lib; use GNAT.OS_Lib;
-with System.HTable;
-
package Prj is
Subdirs_Option : constant String := "--subdirs=";
@@ -402,6 +399,13 @@ package Prj is
No_Source : constant Source_Id := 0;
+ type Path_Syntax_Kind is
+ (Canonical,
+ -- Unix style
+
+ Host);
+ -- Host specific syntax, for example on VMS (the default)
+
type Language_Config is record
Kind : Language_Kind := File_Based;
-- Kind of language. All languages are file based, except Ada which is
@@ -426,6 +430,10 @@ package Prj is
-- The list of switches that are required as a minimum to invoke the
-- compiler driver.
+ Path_Syntax : Path_Syntax_Kind := Host;
+ -- Value may be Canonical (Unix style) or Host (host syntax, for example
+ -- on VMS for DEC C).
+
Compilation_PIC_Option : Name_List_Index := No_Name_List;
-- The option(s) to compile a source in Position Independent Code for
-- shared libraries. Specified in the configuration. When not specified,
@@ -528,12 +536,6 @@ package Prj is
Toolchain_Description : Name_Id := No_Name;
-- Hold the value of attribute Toolchain_Description for the language
- PIC_Option : Name_Id := No_Name;
- -- Hold the value of attribute Compiler'PIC_Option for the language
-
- Objects_Generated : Boolean := True;
- -- Indicates if objects are generated for the language
-
end record;
-- Record describing the configuration of a language
@@ -544,6 +546,7 @@ package Prj is
Compiler_Driver => No_File,
Compiler_Driver_Path => null,
Compiler_Required_Switches => No_Name_List,
+ Path_Syntax => Canonical,
Compilation_PIC_Option => No_Name_List,
Object_Generated => True,
Objects_Linked => True,
@@ -570,9 +573,7 @@ package Prj is
Binder_Required_Switches => No_Name_List,
Binder_Prefix => No_Name,
Toolchain_Version => No_Name,
- Toolchain_Description => No_Name,
- PIC_Option => No_Name,
- Objects_Generated => True);
+ Toolchain_Description => No_Name);
type Language_Data is record
Name : Name_Id := No_Name;
@@ -838,164 +839,6 @@ package Prj is
-- Similar to 'Value (but avoid use of this attribute in compiler)
-- Raises Constraint_Error if not a Casing_Type image.
- -- Declarations for gprmake:
-
- First_Language_Index : constant Language_Index := 1;
- First_Language_Indexes_Last : constant Language_Index := 5;
-
- Ada_Language_Index : constant Language_Index :=
- First_Language_Index;
- C_Language_Index : constant Language_Index :=
- Ada_Language_Index + 1;
- C_Plus_Plus_Language_Index : constant Language_Index :=
- C_Language_Index + 1;
-
- Last_Language_Index : Language_Index := No_Language_Index;
-
- subtype First_Language_Indexes is Language_Index
- range First_Language_Index .. First_Language_Indexes_Last;
-
- package Language_Indexes is new System.HTable.Simple_HTable
- (Header_Num => Header_Num,
- Element => Language_Index,
- No_Element => No_Language_Index,
- Key => Name_Id,
- Hash => Hash,
- Equal => "=");
- -- Mapping of language names to language indexes
-
- package Language_Names is new Table.Table
- (Table_Component_Type => Name_Id,
- Table_Index_Type => Language_Index,
- Table_Low_Bound => 1,
- Table_Initial => 4,
- Table_Increment => 100,
- Table_Name => "Prj.Language_Names");
- -- The table for the name of programming languages
-
- procedure Add_Language_Name (Name : Name_Id);
-
- procedure Display_Language_Name (Language : Language_Index);
-
- type Languages_In_Project is array (First_Language_Indexes) of Boolean;
- -- Set of supported languages used in a project
-
- No_Languages : constant Languages_In_Project := (others => False);
- -- No supported languages are used
-
- type Supp_Language_Index is new Nat;
- No_Supp_Language_Index : constant Supp_Language_Index := 0;
-
- type Supp_Language is record
- Index : Language_Index := No_Language_Index;
- Present : Boolean := False;
- Next : Supp_Language_Index := No_Supp_Language_Index;
- end record;
-
- package Present_Language_Table is new GNAT.Dynamic_Tables
- (Table_Component_Type => Supp_Language,
- Table_Index_Type => Supp_Language_Index,
- Table_Low_Bound => 1,
- Table_Initial => 4,
- Table_Increment => 100);
- -- The table for the presence of languages with an index that is outside
- -- of First_Language_Indexes.
-
- type Impl_Suffix_Array is array (First_Language_Indexes) of File_Name_Type;
- -- Suffixes for the non spec sources of the different supported languages
- -- in a project.
-
- No_Impl_Suffixes : constant Impl_Suffix_Array := (others => No_File);
- -- A default value for the non spec source suffixes
-
- type Supp_Suffix is record
- Index : Language_Index := No_Language_Index;
- Suffix : File_Name_Type := No_File;
- Next : Supp_Language_Index := No_Supp_Language_Index;
- end record;
-
- package Supp_Suffix_Table is new GNAT.Dynamic_Tables
- (Table_Component_Type => Supp_Suffix,
- Table_Index_Type => Supp_Language_Index,
- Table_Low_Bound => 1,
- Table_Initial => 4,
- Table_Increment => 100);
- -- The table for the presence of languages with an index that is outside
- -- of First_Language_Indexes.
-
- type Lang_Kind is (GNU, Other);
-
- type Language_Processing_Data is record
- Compiler_Drivers : Name_List_Index := No_Name_List;
- Compiler_Paths : Name_Id := No_Name;
- Compiler_Kinds : Lang_Kind := GNU;
- Dependency_Options : Name_List_Index := No_Name_List;
- Compute_Dependencies : Name_List_Index := No_Name_List;
- Include_Options : Name_List_Index := No_Name_List;
- Binder_Drivers : Name_Id := No_Name;
- Binder_Driver_Paths : Name_Id := No_Name;
- end record;
-
- Default_Language_Processing_Data :
- constant Language_Processing_Data :=
- (Compiler_Drivers => No_Name_List,
- Compiler_Paths => No_Name,
- Compiler_Kinds => GNU,
- Dependency_Options => No_Name_List,
- Compute_Dependencies => No_Name_List,
- Include_Options => No_Name_List,
- Binder_Drivers => No_Name,
- Binder_Driver_Paths => No_Name);
-
- type First_Language_Processing_Data is
- array (First_Language_Indexes) of Language_Processing_Data;
-
- Default_First_Language_Processing_Data :
- constant First_Language_Processing_Data :=
- (others => Default_Language_Processing_Data);
-
- type Supp_Language_Data is record
- Index : Language_Index := No_Language_Index;
- Data : Language_Processing_Data := Default_Language_Processing_Data;
- Next : Supp_Language_Index := No_Supp_Language_Index;
- end record;
-
- package Supp_Language_Table is new GNAT.Dynamic_Tables
- (Table_Component_Type => Supp_Language_Data,
- Table_Index_Type => Supp_Language_Index,
- Table_Low_Bound => 1,
- Table_Initial => 4,
- Table_Increment => 100);
- -- The table for language data when there are more languages than
- -- in First_Language_Indexes.
-
- type Other_Source_Id is new Nat;
- No_Other_Source : constant Other_Source_Id := 0;
-
- type Other_Source is record
- Language : Language_Index; -- language of the source
- File_Name : File_Name_Type; -- source file simple name
- Path_Name : Path_Name_Type; -- source full path name
- Source_TS : Time_Stamp_Type; -- source file time stamp
- Object_Name : File_Name_Type; -- object file simple name
- Object_Path : Path_Name_Type; -- object full path name
- Object_TS : Time_Stamp_Type; -- object file time stamp
- Dep_Name : File_Name_Type; -- dependency file simple name
- Dep_Path : Path_Name_Type; -- dependency full path name
- Dep_TS : Time_Stamp_Type; -- dependency file time stamp
- Naming_Exception : Boolean := False; -- True if a naming exception
- Next : Other_Source_Id := No_Other_Source;
- end record;
- -- Data for a source in a language other than Ada
-
- package Other_Source_Table is new GNAT.Dynamic_Tables
- (Table_Component_Type => Other_Source,
- Table_Index_Type => Other_Source_Id,
- Table_Low_Bound => 1,
- Table_Initial => 200,
- Table_Increment => 100);
- -- The table for sources of languages other than Ada
-
-- The following record contains data for a naming scheme
type Naming_Data is record
@@ -1044,10 +887,6 @@ package Prj is
-- An associative array listing body file names that do not have the
-- body suffix. Not used by Ada. Indexed by programming language name.
- -- For gprmake:
-
- Impl_Suffixes : Impl_Suffix_Array := No_Impl_Suffixes;
- Supp_Suffixes : Supp_Language_Index := No_Supp_Language_Index;
end record;
function Spec_Suffix_Of
@@ -1407,12 +1246,15 @@ package Prj is
-- Sources --
-------------
+ Ada_Sources_Present : Boolean := True;
+ -- True if there are Ada sources in the project
+
+ Other_Sources_Present : Boolean := True;
+ -- True if there are non-Ada sources in the project
+
Ada_Sources : String_List_Id := Nil_String;
-- The list of all the Ada source file names (gnatmake only)
- Sources : String_List_Id := Nil_String;
- -- Identical to Ada_Sources (for upward compatibility with GPS)
-
First_Source : Source_Id := No_Source;
Last_Source : Source_Id := No_Source;
-- Head and tail of the list of sources
@@ -1451,20 +1293,6 @@ package Prj is
-- use this field directly outside of the project manager, use
-- Prj.Env.Ada_Include_Path instead.
- -------------
- -- Linking --
- -------------
-
- Linker_Name : File_Name_Type := No_File;
- -- Value of attribute Language_Processing'Linker in the project file
-
- Linker_Path : Path_Name_Type := No_Path;
- -- Path of linker when attribute Language_Processing'Linker is specified
-
- Minimum_Linker_Options : Name_List_Index := No_Name_List;
- -- List of options specified in attribute
- -- Language_Processing'Minimum_Linker_Options.
-
-------------------
-- Miscellaneous --
-------------------
@@ -1515,32 +1343,6 @@ package Prj is
-- True if there are comments in the project sources that cannot be kept
-- in the project tree.
- ------------------
- -- For gprmake --
- ------------------
-
- Langs : Languages_In_Project := No_Languages;
- Supp_Languages : Supp_Language_Index := No_Supp_Language_Index;
- -- Indicate the different languages of the source of this project
-
- Ada_Sources_Present : Boolean := True;
- -- True if there are Ada sources in the project
-
- Other_Sources_Present : Boolean := True;
- -- True if there are sources from languages other than Ada in the
- -- project.
-
- First_Other_Source : Other_Source_Id := No_Other_Source;
- -- First source of a language other than Ada
-
- Last_Other_Source : Other_Source_Id := No_Other_Source;
- -- Last source of a language other than Ada
-
- First_Lang_Processing : First_Language_Processing_Data :=
- Default_First_Language_Processing_Data;
- Supp_Language_Processing : Supp_Language_Index :=
- No_Supp_Language_Index;
- -- Language configurations
end record;
function Empty_Project (Tree : Project_Tree_Ref) return Project_Data;
@@ -1560,12 +1362,6 @@ package Prj is
-- Return True when Language_Name (which must be lower case) is one of the
-- languages used for the project.
- function There_Are_Ada_Sources
- (In_Tree : Project_Tree_Ref;
- Project : Project_Id) return Boolean;
- -- ??? needs comment
- -- ??? Name sounds strange, suggested replacement: Ada_Sources_Present
-
Project_Error : exception;
-- Raised by some subprograms in Prj.Attr
@@ -1664,13 +1460,6 @@ package Prj is
Files_HT : Files_Htable.Instance;
Source_Paths_HT : Source_Paths_Htable.Instance;
- -- For gprmake:
-
- Present_Languages : Present_Language_Table.Instance;
- Supp_Suffixes : Supp_Suffix_Table.Instance;
- Supp_Languages : Supp_Language_Table.Instance;
- Other_Sources : Other_Source_Table.Instance;
-
-- Private part
Private_Part : Private_Project_Tree_Data;
@@ -1743,59 +1532,6 @@ package Prj is
(Source_File_Name : File_Name_Type) return File_Name_Type;
-- Returns the switches file name corresponding to a source file name
- -- For gprmake
-
- function Body_Suffix_Of
- (Language : Language_Index;
- In_Project : Project_Data;
- In_Tree : Project_Tree_Ref) return String;
- -- Returns the suffix of sources of language Language in project In_Project
- -- in project tree In_Tree.
-
- function Is_Present
- (Language : Language_Index;
- In_Project : Project_Data;
- In_Tree : Project_Tree_Ref) return Boolean;
- -- Return True when Language is one of the languages used in
- -- project In_Project.
-
- procedure Set
- (Language : Language_Index;
- Present : Boolean;
- In_Project : in out Project_Data;
- In_Tree : Project_Tree_Ref);
- -- Indicate if Language is or not a language used in project In_Project
-
- function Language_Processing_Data_Of
- (Language : Language_Index;
- In_Project : Project_Data;
- In_Tree : Project_Tree_Ref) return Language_Processing_Data;
- -- Return the Language_Processing_Data for language Language in project
- -- In_Project. Return the default when no Language_Processing_Data are
- -- defined for the language.
-
- procedure Set
- (Language_Processing : Language_Processing_Data;
- For_Language : Language_Index;
- In_Project : in out Project_Data;
- In_Tree : Project_Tree_Ref);
- -- Set the Language_Processing_Data for language Language in project
- -- In_Project.
-
- function Suffix_Of
- (Language : Language_Index;
- In_Project : Project_Data;
- In_Tree : Project_Tree_Ref) return File_Name_Type;
- -- Return the suffix for language Language in project In_Project. Return
- -- No_Name when no suffix is defined for the language.
-
- procedure Set
- (Suffix : File_Name_Type;
- For_Language : Language_Index;
- In_Project : in out Project_Data;
- In_Tree : Project_Tree_Ref);
- -- Set the suffix for language Language in project In_Project
-
----------------
-- Temp Files --
----------------
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index b3bbf6a3539..1808cd8a406 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -1331,17 +1331,29 @@ package Rtsfind is
RE_Str_Concat_5, -- System.String_Ops_Concat_5
RE_String_Input, -- System.Strings.Stream_Ops
+ RE_String_Input_Blk_IO, -- System.Strings.Stream_Ops
RE_String_Output, -- System.Strings.Stream_Ops
+ RE_String_Output_Blk_IO, -- System.Strings.Stream_Ops
RE_String_Read, -- System.Strings.Stream_Ops
+ RE_String_Read_Blk_IO, -- System.Strings.Stream_Ops
RE_String_Write, -- System.Strings.Stream_Ops
+ RE_String_Write_Blk_IO, -- System.Strings.Stream_Ops
RE_Wide_String_Input, -- System.Strings.Stream_Ops
+ RE_Wide_String_Input_Blk_IO, -- System.Strings.Stream_Ops
RE_Wide_String_Output, -- System.Strings.Stream_Ops
+ RE_Wide_String_Output_Blk_IO, -- System.Strings.Stream_Ops
RE_Wide_String_Read, -- System.Strings.Stream_Ops
+ RE_Wide_String_Read_Blk_IO, -- System.Strings.Stream_Ops
RE_Wide_String_Write, -- System.Strings.Stream_Ops
+ RE_Wide_String_Write_Blk_IO, -- System.Strings.Stream_Ops
RE_Wide_Wide_String_Input, -- System.Strings.Stream_Ops
+ RE_Wide_Wide_String_Input_Blk_IO, -- System.Strings.Stream_Ops
RE_Wide_Wide_String_Output, -- System.Strings.Stream_Ops
+ RE_Wide_Wide_String_Output_Blk_IO, -- System.Strings.Stream_Ops
RE_Wide_Wide_String_Read, -- System.Strings.Stream_Ops
+ RE_Wide_Wide_String_Read_Blk_IO, -- System.Strings.Stream_Ops
RE_Wide_Wide_String_Write, -- System.Strings.Stream_Ops
+ RE_Wide_Wide_String_Write_Blk_IO, -- System.Strings.Stream_Ops
RE_Task_Info_Type, -- System.Task_Info
RE_Unspecified_Task_Info, -- System.Task_Info
@@ -2473,17 +2485,29 @@ package Rtsfind is
RE_Str_Concat_5 => System_String_Ops_Concat_5,
RE_String_Input => System_Strings_Stream_Ops,
+ RE_String_Input_Blk_IO => System_Strings_Stream_Ops,
RE_String_Output => System_Strings_Stream_Ops,
+ RE_String_Output_Blk_IO => System_Strings_Stream_Ops,
RE_String_Read => System_Strings_Stream_Ops,
+ RE_String_Read_Blk_IO => System_Strings_Stream_Ops,
RE_String_Write => System_Strings_Stream_Ops,
+ RE_String_Write_Blk_IO => System_Strings_Stream_Ops,
RE_Wide_String_Input => System_Strings_Stream_Ops,
+ RE_Wide_String_Input_Blk_IO => System_Strings_Stream_Ops,
RE_Wide_String_Output => System_Strings_Stream_Ops,
+ RE_Wide_String_Output_Blk_IO => System_Strings_Stream_Ops,
RE_Wide_String_Read => System_Strings_Stream_Ops,
+ RE_Wide_String_Read_Blk_IO => System_Strings_Stream_Ops,
RE_Wide_String_Write => System_Strings_Stream_Ops,
+ RE_Wide_String_Write_Blk_IO => System_Strings_Stream_Ops,
RE_Wide_Wide_String_Input => System_Strings_Stream_Ops,
+ RE_Wide_Wide_String_Input_Blk_IO => System_Strings_Stream_Ops,
RE_Wide_Wide_String_Output => System_Strings_Stream_Ops,
+ RE_Wide_Wide_String_Output_Blk_IO => System_Strings_Stream_Ops,
RE_Wide_Wide_String_Read => System_Strings_Stream_Ops,
+ RE_Wide_Wide_String_Read_Blk_IO => System_Strings_Stream_Ops,
RE_Wide_Wide_String_Write => System_Strings_Stream_Ops,
+ RE_Wide_Wide_String_Write_Blk_IO => System_Strings_Stream_Ops,
RE_Task_Info_Type => System_Task_Info,
RE_Unspecified_Task_Info => System_Task_Info,
diff --git a/gcc/ada/s-direio.adb b/gcc/ada/s-direio.adb
index c764a1c658e..8a6dd435e7c 100644
--- a/gcc/ada/s-direio.adb
+++ b/gcc/ada/s-direio.adb
@@ -251,9 +251,12 @@ package body System.Direct_IO is
-----------
procedure Reset (File : in out File_Type; Mode : FCB.File_Mode) is
- pragma Unmodified (File);
+ pragma Warnings (Off, File);
-- File is actually modified via Unrestricted_Access below, but
-- GNAT will generate a warning anyway.
+ -- Note that we do not use pragma Unmodified here, since in -gnatc
+ -- mode, GNAT will complain that File is modified for
+ -- "File.Index := 1;"
begin
FIO.Reset (AP (File)'Unrestricted_Access, Mode);
@@ -262,9 +265,8 @@ package body System.Direct_IO is
end Reset;
procedure Reset (File : in out File_Type) is
- pragma Unmodified (File);
- -- File is actually modified via Unrestricted_Access below, but
- -- GNAT will generate a warning anyway.
+ pragma Warnings (Off, File);
+ -- See above (other Reset procedure) for explanations on this pragma
begin
FIO.Reset (AP (File)'Unrestricted_Access);
diff --git a/gcc/ada/s-finimp.ads b/gcc/ada/s-finimp.ads
index 5bd1be1f8fd..7895326f85f 100644
--- a/gcc/ada/s-finimp.ads
+++ b/gcc/ada/s-finimp.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -66,7 +66,7 @@ package System.Finalization_Implementation is
-- packages. They will be finalized after the main program completion.
procedure Finalize_Global_List;
- -- The procedure to be called in order to finalize the global list;
+ -- The procedure to be called in order to finalize the global list
procedure Attach_To_Final_List
(L : in out SFR.Finalizable_Ptr;
@@ -102,7 +102,7 @@ package System.Finalization_Implementation is
-- return object to the caller's finalization list.
procedure Finalize_List (L : SFR.Finalizable_Ptr);
- -- Call Finalize on each element of the list L;
+ -- Call Finalize on each element of the list L
procedure Finalize_One (Obj : in out SFR.Finalizable);
-- Call Finalize on Obj and remove its final list
diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb
index 5655b3c0d7c..8edc7c93a9b 100755
--- a/gcc/ada/s-os_lib.adb
+++ b/gcc/ada/s-os_lib.adb
@@ -792,9 +792,9 @@ package body System.OS_Lib is
-- If it is not a digit, then there are no available
-- temp file names. Return Invalid_FD. There is almost
- -- no that this code will be ever be executed, since
- -- it would mean that there are one million temp files
- -- in the same directory!
+ -- no chance that this code will be ever be executed,
+ -- since it would mean that there are one million temp
+ -- files in the same directory!
SSL.Unlock_Task.all;
FD := Invalid_FD;
@@ -1921,6 +1921,26 @@ package body System.OS_Lib is
end;
end if;
+ -- On Windows, remove all double-quotes that are possibly part of the
+ -- path but can cause problems with other methods.
+
+ if On_Windows then
+ declare
+ Index : Natural;
+
+ begin
+ Index := Path_Buffer'First;
+ for Current in Path_Buffer'First .. End_Path loop
+ if Path_Buffer (Current) /= '"' then
+ Path_Buffer (Index) := Path_Buffer (Current);
+ Index := Index + 1;
+ end if;
+ end loop;
+
+ End_Path := Index - 1;
+ end;
+ end if;
+
-- Start the conversions
-- If this is not finished after Max_Iterations, give up and return an
diff --git a/gcc/ada/s-parame-vxworks.adb b/gcc/ada/s-parame-vxworks.adb
index 240a9d8f716..21838ddcc41 100644
--- a/gcc/ada/s-parame-vxworks.adb
+++ b/gcc/ada/s-parame-vxworks.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1995-2008, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -31,7 +31,7 @@
-- --
------------------------------------------------------------------------------
--- Version used on all VxWorks and Nucleus targets
+-- Version used on all VxWorks, Nucleus, and RTX RTSS targets
package body System.Parameters is
diff --git a/gcc/ada/s-regexp.ads b/gcc/ada/s-regexp.ads
index d114f0d0ae6..a1f9bf732cf 100755
--- a/gcc/ada/s-regexp.ads
+++ b/gcc/ada/s-regexp.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1998-2007, AdaCore --
+-- Copyright (C) 1998-2008, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -109,7 +109,7 @@ package System.Regexp is
Glob : Boolean := False;
Case_Sensitive : Boolean := True) return Regexp;
-- Compiles a regular expression S. If the syntax of the given
- -- expression is invalid (does not match above grammar, Error_In_Regexp
+ -- expression is invalid (does not match above grammar), Error_In_Regexp
-- is raised. If Glob is True, the pattern is considered as a 'globbing
-- pattern', that is a pattern as given by the second grammar above.
-- As a special case, if Pattern is the empty string it will always
diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads
index bbe422377de..b31d212b85a 100644
--- a/gcc/ada/s-rident.ads
+++ b/gcc/ada/s-rident.ads
@@ -102,6 +102,7 @@ package System.Rident is
No_Select_Statements, -- GNAT (Ravenscar)
No_Specific_Termination_Handlers, -- (RM D.7(10.7/2))
No_Standard_Storage_Pools, -- GNAT
+ No_Stream_Optimizations, -- GNAT
No_Streams, -- GNAT
No_Task_Allocators, -- (RM D.7(7))
No_Task_Attributes_Package, -- GNAT
diff --git a/gcc/ada/s-stausa.adb b/gcc/ada/s-stausa.adb
index 700c685ea27..d9b972d8b28 100644
--- a/gcc/ada/s-stausa.adb
+++ b/gcc/ada/s-stausa.adb
@@ -258,20 +258,29 @@ package body System.Stack_Usage is
-- big, the more an "instrumentation threshold at writing" error is
-- likely to happen.
- Current_Stack_Level : aliased Integer;
+ Stack_Used_When_Filling : Integer;
+ Current_Stack_Level : aliased Integer;
begin
-- Readjust the pattern size. When we arrive in this function, there is
-- already a given amount of stack used, that we won't analyze.
- Analyzer.Stack_Used_When_Filling :=
+ Stack_Used_When_Filling :=
Stack_Size
(Analyzer.Bottom_Of_Stack,
To_Stack_Address (Current_Stack_Level'Address))
+ Natural (Current_Stack_Level'Size);
- Analyzer.Pattern_Size :=
- Analyzer.Pattern_Size - Analyzer.Stack_Used_When_Filling;
+ if Stack_Used_When_Filling > Analyzer.Pattern_Size then
+ -- In this case, the known size of the stack is too small, we've
+ -- already taken more than expected, so there's no possible
+ -- computation
+
+ Analyzer.Pattern_Size := 0;
+ else
+ Analyzer.Pattern_Size :=
+ Analyzer.Pattern_Size - Stack_Used_When_Filling;
+ end if;
declare
Stack : aliased Stack_Slots
@@ -282,10 +291,15 @@ package body System.Stack_Usage is
Analyzer.Stack_Overlay_Address := Stack'Address;
- Analyzer.Bottom_Pattern_Mark :=
- To_Stack_Address (Stack (Bottom_Slot_Index_In (Stack))'Address);
- Analyzer.Top_Pattern_Mark :=
- To_Stack_Address (Stack (Top_Slot_Index_In (Stack))'Address);
+ if Analyzer.Pattern_Size /= 0 then
+ Analyzer.Bottom_Pattern_Mark :=
+ To_Stack_Address (Stack (Bottom_Slot_Index_In (Stack))'Address);
+ Analyzer.Top_Pattern_Mark :=
+ To_Stack_Address (Stack (Top_Slot_Index_In (Stack))'Address);
+ else
+ Analyzer.Bottom_Pattern_Mark := To_Stack_Address (Stack'Address);
+ Analyzer.Bottom_Pattern_Mark := To_Stack_Address (Stack'Address);
+ end if;
-- If Arr has been packed, the following assertion must be true (we
-- add the size of the element whose address is:
@@ -539,20 +553,28 @@ package body System.Stack_Usage is
-------------------
procedure Report_Result (Analyzer : Stack_Analyzer) is
- Measure : constant Natural :=
- Stack_Size
- (Analyzer.Topmost_Touched_Mark,
- Analyzer.Bottom_Of_Stack)
- + Analyzer.Stack_Used_When_Filling;
-
- Result : constant Task_Result :=
+ Result : Task_Result :=
(Task_Name => Analyzer.Task_Name,
Max_Size => Analyzer.Stack_Size,
- Min_Measure => Measure,
- Max_Measure => Measure + Analyzer.Stack_Size
- - Analyzer.Pattern_Size);
+ Min_Measure => 0,
+ Max_Measure => 0);
begin
+ if Analyzer.Pattern_Size = 0 then
+ -- If we have that result, it means that we didn't do any computation
+ -- at all. In other words, we used at least everything (and possibly
+ -- more).
+
+ Result.Min_Measure := Analyzer.Stack_Size;
+ Result.Max_Measure := Analyzer.Stack_Size;
+ else
+ Result.Min_Measure := Stack_Size
+ (Analyzer.Topmost_Touched_Mark,
+ Analyzer.Bottom_Of_Stack);
+ Result.Max_Measure := Result.Min_Measure +
+ (Analyzer.Stack_Size - Analyzer.Pattern_Size);
+ end if;
+
if Analyzer.Result_Id in Result_Array'Range then
-- If the result can be stored, then store it in Result_Array
diff --git a/gcc/ada/s-stausa.ads b/gcc/ada/s-stausa.ads
index 8a6e2b67cb5..2aa9dd70d2d 100644
--- a/gcc/ada/s-stausa.ads
+++ b/gcc/ada/s-stausa.ads
@@ -304,10 +304,6 @@ private
Result_Id : Positive;
-- Id of the result. If less than value given to gnatbind -u corresponds
-- to the location in the result array of result for the current task.
-
- Stack_Used_When_Filling : Natural := 0;
- -- Amount of stack that was already used when actually filling the
- -- memory, and therefore not analyzed.
end record;
Environment_Task_Analyzer : Stack_Analyzer;
diff --git a/gcc/ada/s-ststop.adb b/gcc/ada/s-ststop.adb
index 8d181087e97..ca5c880fb31 100644
--- a/gcc/ada/s-ststop.adb
+++ b/gcc/ada/s-ststop.adb
@@ -43,6 +43,11 @@ with System.Stream_Attributes; use System;
package body System.Strings.Stream_Ops is
+ -- The following type describes the low-level IO mechanism used in package
+ -- Stream_Ops_Internal.
+
+ type IO_Kind is (Byte_IO, Block_IO);
+
-- The following package provides an IO framework for strings. Depending
-- on the version of System.Stream_Attributes as well as the size of
-- formal parameter Character_Type, the package will either utilize block
@@ -53,13 +58,24 @@ package body System.Strings.Stream_Ops is
type String_Type is array (Positive range <>) of Character_Type;
package Stream_Ops_Internal is
+ function Input
+ (Strm : access Root_Stream_Type'Class;
+ IO : IO_Kind) return String_Type;
+
+ procedure Output
+ (Strm : access Root_Stream_Type'Class;
+ Item : String_Type;
+ IO : IO_Kind);
+
procedure Read
(Strm : access Root_Stream_Type'Class;
- Item : out String_Type);
+ Item : out String_Type;
+ IO : IO_Kind);
procedure Write
(Strm : access Root_Stream_Type'Class;
- Item : String_Type);
+ Item : String_Type;
+ IO : IO_Kind);
end Stream_Ops_Internal;
-------------------------
@@ -92,18 +108,6 @@ package body System.Strings.Stream_Ops is
subtype String_Block is String_Type (1 .. C_In_Default_Block);
- -- Block IO is used in the following two scenarios:
-
- -- 1) When the size of the character type equals that of the stream
- -- element type, regardless of endianness.
-
- -- 2) When using the standard stream IO routines for elementary
- -- types which guarantees the same endianness over partitions.
-
- Use_Block_IO : constant Boolean :=
- C_Size = SE_Size
- or else Stream_Attributes.Block_IO_OK;
-
-- Conversions to and from Default_Block
function To_Default_Block is
@@ -112,13 +116,74 @@ package body System.Strings.Stream_Ops is
function To_String_Block is
new Ada.Unchecked_Conversion (Default_Block, String_Block);
+ -----------
+ -- Input --
+ -----------
+
+ function Input
+ (Strm : access Root_Stream_Type'Class;
+ IO : IO_Kind) return String_Type
+ is
+ begin
+ if Strm = null then
+ raise Constraint_Error;
+ end if;
+
+ declare
+ Low : Positive;
+ High : Positive;
+
+ begin
+ -- Read the bounds of the string
+
+ Positive'Read (Strm, Low);
+ Positive'Read (Strm, High);
+
+ declare
+ Item : String_Type (Low .. High);
+
+ begin
+ -- Read the character content of the string
+
+ Read (Strm, Item, IO);
+
+ return Item;
+ end;
+ end;
+ end Input;
+
+ ------------
+ -- Output --
+ ------------
+
+ procedure Output
+ (Strm : access Root_Stream_Type'Class;
+ Item : String_Type;
+ IO : IO_Kind)
+ is
+ begin
+ if Strm = null then
+ raise Constraint_Error;
+ end if;
+
+ -- Write the bounds of the string
+
+ Positive'Write (Strm, Item'First);
+ Positive'Write (Strm, Item'Last);
+
+ -- Write the character content of the string
+
+ Write (Strm, Item, IO);
+ end Output;
+
----------
-- Read --
----------
procedure Read
(Strm : access Root_Stream_Type'Class;
- Item : out String_Type)
+ Item : out String_Type;
+ IO : IO_Kind)
is
begin
if Strm = null then
@@ -131,7 +196,11 @@ package body System.Strings.Stream_Ops is
return;
end if;
- if Use_Block_IO then
+ -- Block IO
+
+ if IO = Block_IO
+ and then Stream_Attributes.Block_IO_OK
+ then
declare
-- Determine the size in BITS of the block necessary to contain
-- the whole string.
@@ -215,7 +284,7 @@ package body System.Strings.Stream_Ops is
end if;
end;
- -- Character-by-character IO
+ -- Byte IO
else
declare
@@ -236,7 +305,8 @@ package body System.Strings.Stream_Ops is
procedure Write
(Strm : access Root_Stream_Type'Class;
- Item : String_Type)
+ Item : String_Type;
+ IO : IO_Kind)
is
begin
if Strm = null then
@@ -249,7 +319,11 @@ package body System.Strings.Stream_Ops is
return;
end if;
- if Use_Block_IO then
+ -- Block IO
+
+ if IO = Block_IO
+ and then Stream_Attributes.Block_IO_OK
+ then
declare
-- Determine the size in BITS of the block necessary to contain
-- the whole string.
@@ -303,7 +377,7 @@ package body System.Strings.Stream_Ops is
end if;
end;
- -- Character-by-character IO
+ -- Byte IO
else
for Index in Item'First .. Item'Last loop
@@ -313,7 +387,7 @@ package body System.Strings.Stream_Ops is
end Write;
end Stream_Ops_Internal;
- -- Specific instantiations for different string types
+ -- Specific instantiations for all Ada string types
package String_Ops is
new Stream_Ops_Internal
@@ -338,32 +412,19 @@ package body System.Strings.Stream_Ops is
(Strm : access Ada.Streams.Root_Stream_Type'Class) return String
is
begin
- if Strm = null then
- raise Constraint_Error;
- end if;
-
- declare
- Low : Positive;
- High : Positive;
-
- begin
- -- Read the bounds of the string
-
- Positive'Read (Strm, Low);
- Positive'Read (Strm, High);
-
- declare
- Item : String (Low .. High);
-
- begin
- -- Read the character content of the string
+ return String_Ops.Input (Strm, Byte_IO);
+ end String_Input;
- String_Read (Strm, Item);
+ -------------------------
+ -- String_Input_Blk_IO --
+ -------------------------
- return Item;
- end;
- end;
- end String_Input;
+ function String_Input_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class) return String
+ is
+ begin
+ return String_Ops.Input (Strm, Block_IO);
+ end String_Input_Blk_IO;
-------------------
-- String_Output --
@@ -374,19 +435,20 @@ package body System.Strings.Stream_Ops is
Item : String)
is
begin
- if Strm = null then
- raise Constraint_Error;
- end if;
-
- -- Write the bounds of the string
-
- Positive'Write (Strm, Item'First);
- Positive'Write (Strm, Item'Last);
+ String_Ops.Output (Strm, Item, Byte_IO);
+ end String_Output;
- -- Write the character content of the string
+ --------------------------
+ -- String_Output_Blk_IO --
+ --------------------------
- String_Write (Strm, Item);
- end String_Output;
+ procedure String_Output_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class;
+ Item : String)
+ is
+ begin
+ String_Ops.Output (Strm, Item, Block_IO);
+ end String_Output_Blk_IO;
-----------------
-- String_Read --
@@ -397,9 +459,21 @@ package body System.Strings.Stream_Ops is
Item : out String)
is
begin
- String_Ops.Read (Strm, Item);
+ String_Ops.Read (Strm, Item, Byte_IO);
end String_Read;
+ ------------------------
+ -- String_Read_Blk_IO --
+ ------------------------
+
+ procedure String_Read_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class;
+ Item : out String)
+ is
+ begin
+ String_Ops.Read (Strm, Item, Block_IO);
+ end String_Read_Blk_IO;
+
------------------
-- String_Write --
------------------
@@ -409,44 +483,42 @@ package body System.Strings.Stream_Ops is
Item : String)
is
begin
- String_Ops.Write (Strm, Item);
+ String_Ops.Write (Strm, Item, Byte_IO);
end String_Write;
+ -------------------------
+ -- String_Write_Blk_IO --
+ -------------------------
+
+ procedure String_Write_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class;
+ Item : String)
+ is
+ begin
+ String_Ops.Write (Strm, Item, Block_IO);
+ end String_Write_Blk_IO;
+
-----------------------
-- Wide_String_Input --
-----------------------
function Wide_String_Input
- (Strm : access Ada.Streams.Root_Stream_Type'Class)
- return Wide_String
+ (Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_String
is
begin
- if Strm = null then
- raise Constraint_Error;
- end if;
-
- declare
- Low : Positive;
- High : Positive;
-
- begin
- -- Read the bounds of the string
-
- Positive'Read (Strm, Low);
- Positive'Read (Strm, High);
-
- declare
- Item : Wide_String (Low .. High);
-
- begin
- -- Read the character content of the string
+ return Wide_String_Ops.Input (Strm, Byte_IO);
+ end Wide_String_Input;
- Wide_String_Read (Strm, Item);
+ ------------------------------
+ -- Wide_String_Input_Blk_IO --
+ ------------------------------
- return Item;
- end;
- end;
- end Wide_String_Input;
+ function Wide_String_Input_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_String
+ is
+ begin
+ return Wide_String_Ops.Input (Strm, Block_IO);
+ end Wide_String_Input_Blk_IO;
------------------------
-- Wide_String_Output --
@@ -457,19 +529,20 @@ package body System.Strings.Stream_Ops is
Item : Wide_String)
is
begin
- if Strm = null then
- raise Constraint_Error;
- end if;
-
- -- Write the bounds of the string
-
- Positive'Write (Strm, Item'First);
- Positive'Write (Strm, Item'Last);
+ Wide_String_Ops.Output (Strm, Item, Byte_IO);
+ end Wide_String_Output;
- -- Write the character content of the string
+ -------------------------------
+ -- Wide_String_Output_Blk_IO --
+ -------------------------------
- Wide_String_Write (Strm, Item);
- end Wide_String_Output;
+ procedure Wide_String_Output_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class;
+ Item : Wide_String)
+ is
+ begin
+ Wide_String_Ops.Output (Strm, Item, Block_IO);
+ end Wide_String_Output_Blk_IO;
----------------------
-- Wide_String_Read --
@@ -480,9 +553,21 @@ package body System.Strings.Stream_Ops is
Item : out Wide_String)
is
begin
- Wide_String_Ops.Read (Strm, Item);
+ Wide_String_Ops.Read (Strm, Item, Byte_IO);
end Wide_String_Read;
+ -----------------------------
+ -- Wide_String_Read_Blk_IO --
+ -----------------------------
+
+ procedure Wide_String_Read_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class;
+ Item : out Wide_String)
+ is
+ begin
+ Wide_String_Ops.Read (Strm, Item, Block_IO);
+ end Wide_String_Read_Blk_IO;
+
-----------------------
-- Wide_String_Write --
-----------------------
@@ -492,44 +577,42 @@ package body System.Strings.Stream_Ops is
Item : Wide_String)
is
begin
- Wide_String_Ops.Write (Strm, Item);
+ Wide_String_Ops.Write (Strm, Item, Byte_IO);
end Wide_String_Write;
+ ------------------------------
+ -- Wide_String_Write_Blk_IO --
+ ------------------------------
+
+ procedure Wide_String_Write_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class;
+ Item : Wide_String)
+ is
+ begin
+ Wide_String_Ops.Write (Strm, Item, Block_IO);
+ end Wide_String_Write_Blk_IO;
+
----------------------------
-- Wide_Wide_String_Input --
----------------------------
function Wide_Wide_String_Input
- (Strm : access Ada.Streams.Root_Stream_Type'Class)
- return Wide_Wide_String
+ (Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_Wide_String
is
begin
- if Strm = null then
- raise Constraint_Error;
- end if;
-
- declare
- Low : Positive;
- High : Positive;
-
- begin
- -- Read the bounds of the string
-
- Positive'Read (Strm, Low);
- Positive'Read (Strm, High);
-
- declare
- Item : Wide_Wide_String (Low .. High);
-
- begin
- -- Read the character content of the string
+ return Wide_Wide_String_Ops.Input (Strm, Byte_IO);
+ end Wide_Wide_String_Input;
- Wide_Wide_String_Read (Strm, Item);
+ -----------------------------------
+ -- Wide_Wide_String_Input_Blk_IO --
+ -----------------------------------
- return Item;
- end;
- end;
- end Wide_Wide_String_Input;
+ function Wide_Wide_String_Input_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_Wide_String
+ is
+ begin
+ return Wide_Wide_String_Ops.Input (Strm, Block_IO);
+ end Wide_Wide_String_Input_Blk_IO;
-----------------------------
-- Wide_Wide_String_Output --
@@ -540,19 +623,20 @@ package body System.Strings.Stream_Ops is
Item : Wide_Wide_String)
is
begin
- if Strm = null then
- raise Constraint_Error;
- end if;
-
- -- Write the bounds of the string
-
- Positive'Write (Strm, Item'First);
- Positive'Write (Strm, Item'Last);
+ Wide_Wide_String_Ops.Output (Strm, Item, Byte_IO);
+ end Wide_Wide_String_Output;
- -- Write the character content of the string
+ ------------------------------------
+ -- Wide_Wide_String_Output_Blk_IO --
+ ------------------------------------
- Wide_Wide_String_Write (Strm, Item);
- end Wide_Wide_String_Output;
+ procedure Wide_Wide_String_Output_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class;
+ Item : Wide_Wide_String)
+ is
+ begin
+ Wide_Wide_String_Ops.Output (Strm, Item, Block_IO);
+ end Wide_Wide_String_Output_Blk_IO;
---------------------------
-- Wide_Wide_String_Read --
@@ -563,9 +647,21 @@ package body System.Strings.Stream_Ops is
Item : out Wide_Wide_String)
is
begin
- Wide_Wide_String_Ops.Read (Strm, Item);
+ Wide_Wide_String_Ops.Read (Strm, Item, Byte_IO);
end Wide_Wide_String_Read;
+ ----------------------------------
+ -- Wide_Wide_String_Read_Blk_IO --
+ ----------------------------------
+
+ procedure Wide_Wide_String_Read_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class;
+ Item : out Wide_Wide_String)
+ is
+ begin
+ Wide_Wide_String_Ops.Read (Strm, Item, Block_IO);
+ end Wide_Wide_String_Read_Blk_IO;
+
----------------------------
-- Wide_Wide_String_Write --
----------------------------
@@ -575,7 +671,19 @@ package body System.Strings.Stream_Ops is
Item : Wide_Wide_String)
is
begin
- Wide_Wide_String_Ops.Write (Strm, Item);
+ Wide_Wide_String_Ops.Write (Strm, Item, Byte_IO);
end Wide_Wide_String_Write;
+ -----------------------------------
+ -- Wide_Wide_String_Write_Blk_IO --
+ -----------------------------------
+
+ procedure Wide_Wide_String_Write_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class;
+ Item : Wide_Wide_String)
+ is
+ begin
+ Wide_Wide_String_Ops.Write (Strm, Item, Block_IO);
+ end Wide_Wide_String_Write_Blk_IO;
+
end System.Strings.Stream_Ops;
diff --git a/gcc/ada/s-ststop.ads b/gcc/ada/s-ststop.ads
index f954bccfc7b..432b1335d50 100644
--- a/gcc/ada/s-ststop.ads
+++ b/gcc/ada/s-ststop.ads
@@ -45,6 +45,8 @@
-- will be expanded into:
--
-- String_Output (Some_Stream, Some_String);
+-- or
+-- String_Output_Blk_IO (Some_Stream, Some_String);
pragma Warnings (Off);
pragma Compiler_Unit;
@@ -62,18 +64,34 @@ package System.Strings.Stream_Ops is
(Strm : access Ada.Streams.Root_Stream_Type'Class)
return String;
+ function String_Input_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class)
+ return String;
+
procedure String_Output
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : String);
+ procedure String_Output_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class;
+ Item : String);
+
procedure String_Read
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : out String);
+ procedure String_Read_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class;
+ Item : out String);
+
procedure String_Write
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : String);
+ procedure String_Write_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class;
+ Item : String);
+
-----------------------------------
-- Wide_String stream operations --
-----------------------------------
@@ -82,18 +100,34 @@ package System.Strings.Stream_Ops is
(Strm : access Ada.Streams.Root_Stream_Type'Class)
return Wide_String;
+ function Wide_String_Input_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class)
+ return Wide_String;
+
procedure Wide_String_Output
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : Wide_String);
+ procedure Wide_String_Output_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class;
+ Item : Wide_String);
+
procedure Wide_String_Read
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : out Wide_String);
+ procedure Wide_String_Read_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class;
+ Item : out Wide_String);
+
procedure Wide_String_Write
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : Wide_String);
+ procedure Wide_String_Write_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class;
+ Item : Wide_String);
+
----------------------------------------
-- Wide_Wide_String stream operations --
----------------------------------------
@@ -102,16 +136,32 @@ package System.Strings.Stream_Ops is
(Strm : access Ada.Streams.Root_Stream_Type'Class)
return Wide_Wide_String;
+ function Wide_Wide_String_Input_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class)
+ return Wide_Wide_String;
+
procedure Wide_Wide_String_Output
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : Wide_Wide_String);
+ procedure Wide_Wide_String_Output_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class;
+ Item : Wide_Wide_String);
+
procedure Wide_Wide_String_Read
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : out Wide_Wide_String);
+ procedure Wide_Wide_String_Read_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class;
+ Item : out Wide_Wide_String);
+
procedure Wide_Wide_String_Write
(Strm : access Ada.Streams.Root_Stream_Type'Class;
Item : Wide_Wide_String);
+ procedure Wide_Wide_String_Write_Blk_IO
+ (Strm : access Ada.Streams.Root_Stream_Type'Class;
+ Item : Wide_Wide_String);
+
end System.Strings.Stream_Ops;
diff --git a/gcc/ada/scans.ads b/gcc/ada/scans.ads
index 83cc368dee4..e344f74433b 100644
--- a/gcc/ada/scans.ads
+++ b/gcc/ada/scans.ads
@@ -338,8 +338,7 @@ package Scans is
-- Flag array used to test for reserved word
procedure Initialize_Ada_Keywords;
- -- Set up Token_Type values in Names table entries for Ada reserved
- -- words.
+ -- Set up Token_Type values in Names table entries for Ada reserved words
--------------------------
-- Scan State Variables --
diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb
index 76f63f9353b..914c101afdc 100644
--- a/gcc/ada/scng.adb
+++ b/gcc/ada/scng.adb
@@ -350,6 +350,7 @@ package body Scng is
procedure Error_Illegal_Wide_Character is
begin
+ Scan_Ptr := Scan_Ptr + 1;
Error_Msg ("illegal wide character", Wptr);
end Error_Illegal_Wide_Character;
@@ -1651,7 +1652,7 @@ package body Scng is
if Err then
Error_Illegal_Wide_Character;
- Code := Character'Pos (' ');
+ Code := Character'Pos (' ');
-- In Ada 95 mode we allow any wide character in a character
-- literal, but in Ada 2005, the set of characters allowed
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 4f50dc01789..d16b7d6b8c4 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -2770,7 +2770,17 @@ package body Sem_Aggr is
Error_Msg_N ("record aggregate cannot be null", N);
return;
- elsif No (First_Entity (Typ)) then
+ -- If the type has no components, then the aggregate should either
+ -- have "null record", or in Ada 2005 it could instead have a single
+ -- component association given by "others => <>". For Ada 95 we flag
+ -- an error at this point, but for Ada 2005 we proceed with checking
+ -- the associations below, which will catch the case where it's not
+ -- an aggregate with "others => <>". Note that the legality of a <>
+ -- aggregate for a null record type was established by AI05-016.
+
+ elsif No (First_Entity (Typ))
+ and then Ada_Version < Ada_05
+ then
Error_Msg_N ("record aggregate must be null", N);
return;
end if;
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 14f9102d369..4b599151f8e 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -1898,6 +1898,7 @@ package body Sem_Attr is
and then Aname /= Name_Address
and then Aname /= Name_Code_Address
and then Aname /= Name_Count
+ and then Aname /= Name_Result
and then Aname /= Name_Unchecked_Access
then
Error_Attr ("ambiguous prefix for % attribute", P);
@@ -3741,6 +3742,16 @@ package body Sem_Attr is
PS : constant Entity_Id := Scope (CS);
begin
+ -- If the enclosing subprogram is always inlined, the enclosing
+ -- postcondition will not be propagated to the expanded call.
+
+ if Has_Pragma_Inline_Always (PS)
+ and then Warn_On_Redundant_Constructs
+ then
+ Error_Msg_N
+ ("postconditions on inlined functions not enforced?", N);
+ end if;
+
-- If we are in the scope of a function and in Spec_Expression mode,
-- this is likely the prescan of the postcondition pragma, and we
-- just set the proper type. If there is an error it will be caught
@@ -3775,9 +3786,23 @@ package body Sem_Attr is
then
-- Check OK prefix
- if Nkind (P) /= N_Identifier
- or else Chars (P) /= Chars (PS)
+ if (Nkind (P) = N_Identifier
+ or else Nkind (P) = N_Operator_Symbol)
+ and then Chars (P) = Chars (PS)
+ then
+ null;
+
+ -- Within an instance, the prefix designates the local renaming
+ -- of the original generic.
+
+ elsif Is_Entity_Name (P)
+ and then Ekind (Entity (P)) = E_Function
+ and then Present (Alias (Entity (P)))
+ and then Chars (Alias (Entity (P))) = Chars (PS)
then
+ null;
+
+ else
Error_Msg_NE
("incorrect prefix for % attribute, expected &", P, PS);
Error_Attr;
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 540b2a6d85d..026e434f7a3 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -2660,13 +2660,18 @@ package body Sem_Ch10 is
P : Node_Id;
function Build_Unit_Name (Nam : Node_Id) return Node_Id;
- -- Comment required here ???
+ -- Build name to be used in implicit with_clause. In most cases this
+ -- is the source name, but if renamings are present we must make the
+ -- original unit visible, not the one it renames. The entity in the
+ -- use clause is the renamed unit, but the identifier is the one from
+ -- the source, which allows us to recover the unit renaming.
---------------------
-- Build_Unit_Name --
---------------------
function Build_Unit_Name (Nam : Node_Id) return Node_Id is
+ Ent : Entity_Id;
Renaming : Entity_Id;
Result : Node_Id;
@@ -2695,12 +2700,33 @@ package body Sem_Ch10 is
end if;
else
+ Ent := Entity (Nam);
+
+ if Present (Entity (Selector_Name (Nam)))
+ and then Chars (Entity (Selector_Name (Nam))) /= Chars (Ent)
+ and then
+ Nkind (Unit_Declaration_Node (Entity (Selector_Name (Nam))))
+ = N_Package_Renaming_Declaration
+ then
+ -- The name in the with_clause is of the form A.B.C, and B
+ -- is given by a renaming declaration. In that case we may
+ -- not have analyzed the unit for B, but replaced it directly
+ -- in lib-load with the unit it renames. We have to make A.B
+ -- visible, so analyze the declaration for B now, in case it
+ -- has not been done yet.
+
+ Ent := Entity (Selector_Name (Nam));
+ Analyze
+ (Parent
+ (Unit_Declaration_Node (Entity (Selector_Name (Nam)))));
+ end if;
+
Result :=
Make_Expanded_Name (Loc,
Chars => Chars (Entity (Nam)),
Prefix => Build_Unit_Name (Prefix (Nam)),
- Selector_Name => New_Occurrence_Of (Entity (Nam), Loc));
- Set_Entity (Result, Entity (Nam));
+ Selector_Name => New_Occurrence_Of (Ent, Loc));
+ Set_Entity (Result, Ent);
return Result;
end if;
end Build_Unit_Name;
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index cae84097d1a..282104fdd9a 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -2413,10 +2413,9 @@ package body Sem_Ch12 is
Error_Msg_N ("no visible entity matches specification", Def);
end if;
- else
-
- -- Several interpretations. Disambiguate as for a renaming.
+ -- More than one interpretation, so disambiguate as for a renaming
+ else
declare
I : Interp_Index;
I1 : Interp_Index := 0;
@@ -2427,7 +2426,6 @@ package body Sem_Ch12 is
Subp := Any_Id;
Get_First_Interp (Def, I, It);
while Present (It.Nam) loop
-
if Entity_Matches_Spec (It.Nam, Nam) then
if Subp /= Any_Id then
It1 := Disambiguate (Def, I1, I, Etype (Subp));
@@ -3755,6 +3753,38 @@ package body Sem_Ch12 is
Analyze_Subprogram_Instantiation (N, E_Procedure);
end Analyze_Procedure_Instantiation;
+ -----------------------------------
+ -- Need_Subprogram_Instance_Body --
+ -----------------------------------
+
+ function Need_Subprogram_Instance_Body
+ (N : Node_Id;
+ Subp : Entity_Id) return Boolean
+ is
+ begin
+ if (Is_In_Main_Unit (N)
+ or else Is_Inlined (Subp)
+ or else Is_Inlined (Alias (Subp)))
+ and then (Operating_Mode = Generate_Code
+ or else (Operating_Mode = Check_Semantics
+ and then ASIS_Mode))
+ and then (Expander_Active or else ASIS_Mode)
+ and then not ABE_Is_Certain (N)
+ and then not Is_Eliminated (Subp)
+ then
+ Pending_Instantiations.Append
+ ((Inst_Node => N,
+ Act_Decl => Unit_Declaration_Node (Subp),
+ Expander_Status => Expander_Active,
+ Current_Sem_Unit => Current_Sem_Unit,
+ Scope_Suppress => Scope_Suppress,
+ Local_Suppress_Stack_Top => Local_Suppress_Stack_Top));
+ return True;
+ else
+ return False;
+ end if;
+ end Need_Subprogram_Instance_Body;
+
--------------------------------------
-- Analyze_Subprogram_Instantiation --
--------------------------------------
@@ -4146,22 +4176,7 @@ package body Sem_Ch12 is
-- If the context requires a full instantiation, mark node for
-- subsequent construction of the body.
- if (Is_In_Main_Unit (N)
- or else Is_Inlined (Act_Decl_Id))
- and then (Operating_Mode = Generate_Code
- or else (Operating_Mode = Check_Semantics
- and then ASIS_Mode))
- and then (Expander_Active or else ASIS_Mode)
- and then not ABE_Is_Certain (N)
- and then not Is_Eliminated (Act_Decl_Id)
- then
- Pending_Instantiations.Append
- ((Inst_Node => N,
- Act_Decl => Act_Decl,
- Expander_Status => Expander_Active,
- Current_Sem_Unit => Current_Sem_Unit,
- Scope_Suppress => Scope_Suppress,
- Local_Suppress_Stack_Top => Local_Suppress_Stack_Top));
+ if Need_Subprogram_Instance_Body (N, Act_Decl_Id) then
Check_Forward_Instantiation (Gen_Decl);
@@ -8701,6 +8716,13 @@ package body Sem_Ch12 is
begin
Gen_Body_Id := Corresponding_Body (Gen_Decl);
+ -- Subprogram body may have been created already because of
+ -- an inline pragma.
+
+ if Present (Corresponding_Body (Act_Decl)) then
+ return;
+ end if;
+
Expander_Mode_Save_And_Set (Body_Info.Expander_Status);
-- Re-establish the state of information on which checks are suppressed.
@@ -10855,11 +10877,11 @@ package body Sem_Ch12 is
Set_Is_Immediately_Visible (P, False);
-- If the current scope is itself an instantiation of a generic
- -- nested within P, and we are in the private part of body of
- -- this instantiation, restore the full views of P, that were
- -- removed in End_Package_Scope above. This obscure case can
- -- occur when a subunit of a generic contains an instance of
- -- of a child unit of its generic parent unit.
+ -- nested within P, and we are in the private part of body of this
+ -- instantiation, restore the full views of P, that were removed
+ -- in End_Package_Scope above. This obscure case can occur when a
+ -- subunit of a generic contains an instance of a child unit of
+ -- its generic parent unit.
elsif S = Current_Scope
and then Is_Generic_Instance (S)
diff --git a/gcc/ada/sem_ch12.ads b/gcc/ada/sem_ch12.ads
index 7ebb2e88342..c3b34173e18 100644
--- a/gcc/ada/sem_ch12.ads
+++ b/gcc/ada/sem_ch12.ads
@@ -106,6 +106,16 @@ package Sem_Ch12 is
-- function and procedure instances. The flag Body_Optional has the
-- same purpose as described for Instantiate_Package_Body.
+ function Need_Subprogram_Instance_Body
+ (N : Node_Id;
+ Subp : Entity_Id) return Boolean;
+
+ -- If a subprogram instance is inlined, indicate that the body of it
+ -- must be created, to be used in inlined calls by the back-end. The
+ -- subprogram may be inlined because the generic itself carries the
+ -- pragma, or because a pragma appears for the instance in the scope.
+ -- of the instance.
+
procedure Save_Global_References (N : Node_Id);
-- Traverse the original generic unit, and capture all references to
-- entities that are defined outside of the generic in the analyzed
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index e14fb436d6b..eb9b52e3d17 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -684,12 +684,16 @@ package body Sem_Ch4 is
procedure Analyze_Call (N : Node_Id) is
Actuals : constant List_Id := Parameter_Associations (N);
- Nam : Node_Id := Name (N);
+ Nam : Node_Id;
X : Interp_Index;
It : Interp;
Nam_Ent : Entity_Id;
Success : Boolean := False;
+ Deref : Boolean := False;
+ -- Flag indicates whether an interpretation of the prefix is a
+ -- parameterless call that returns an access_to_subprogram.
+
function Name_Denotes_Function return Boolean;
-- If the type of the name is an access to subprogram, this may be the
-- type of a name, or the return type of the function being called. If
@@ -762,6 +766,8 @@ package body Sem_Ch4 is
Set_Etype (N, Any_Type);
+ Nam := Name (N);
+
if not Is_Overloaded (Nam) then
-- Only one interpretation to check
@@ -874,6 +880,7 @@ package body Sem_Ch4 is
while Present (It.Nam) loop
Nam_Ent := It.Nam;
+ Deref := False;
-- Name may be call that returns an access to subprogram, or more
-- generally an overloaded expression one of whose interpretations
@@ -888,11 +895,17 @@ package body Sem_Ch4 is
Nam_Ent := Designated_Type (Nam_Ent);
elsif Is_Access_Type (Etype (Nam_Ent))
- and then not Is_Entity_Name (Nam)
+ and then
+ (not Is_Entity_Name (Nam)
+ or else Nkind (N) = N_Procedure_Call_Statement)
and then Ekind (Designated_Type (Etype (Nam_Ent)))
= E_Subprogram_Type
then
Nam_Ent := Designated_Type (Etype (Nam_Ent));
+
+ if Is_Entity_Name (Nam) then
+ Deref := True;
+ end if;
end if;
Analyze_One_Call (N, Nam_Ent, False, Success);
@@ -904,7 +917,16 @@ package body Sem_Ch4 is
-- guation is done directly in Resolve.
if Success then
- Set_Etype (Nam, It.Typ);
+ if Deref
+ and then Nkind (Parent (N)) /= N_Explicit_Dereference
+ then
+ Set_Entity (Nam, It.Nam);
+ Insert_Explicit_Dereference (Nam);
+ Set_Etype (Nam, Nam_Ent);
+
+ else
+ Set_Etype (Nam, It.Typ);
+ end if;
elsif Nkind_In (Name (N), N_Selected_Component,
N_Function_Call)
@@ -1480,14 +1502,15 @@ package body Sem_Ch4 is
and then Is_Overloaded (N)
then
-- The prefix may include access to subprograms and other access
- -- types. If the context selects the interpretation that is a call,
- -- we cannot rewrite the node yet, but we include the result of
- -- the call interpretation.
+ -- types. If the context selects the interpretation that is a
+ -- function call (not a procedure call) we cannot rewrite the
+ -- node yet, but we include the result of the call interpretation.
Get_First_Interp (N, I, It);
while Present (It.Nam) loop
if Ekind (Base_Type (It.Typ)) = E_Subprogram_Type
and then Etype (Base_Type (It.Typ)) /= Standard_Void_Type
+ and then Nkind (Parent (N)) /= N_Procedure_Call_Statement
then
Add_One_Interp (N, Etype (It.Typ), Etype (It.Typ));
end if;
@@ -6380,9 +6403,15 @@ package body Sem_Ch4 is
-----------------------------
function Valid_First_Argument_Of (Op : Entity_Id) return Boolean is
- Typ : constant Entity_Id := Etype (First_Formal (Op));
+ Typ : Entity_Id := Etype (First_Formal (Op));
begin
+ if Is_Concurrent_Type (Typ)
+ and then Present (Corresponding_Record_Type (Typ))
+ then
+ Typ := Corresponding_Record_Type (Typ);
+ end if;
+
-- Simple case. Object may be a subtype of the tagged type or
-- may be the corresponding record of a synchronized type.
@@ -6414,6 +6443,10 @@ package body Sem_Ch4 is
-- corresponding record (base) type.
if Is_Concurrent_Type (Obj_Type) then
+ if not Present (Corresponding_Record_Type (Obj_Type)) then
+ return False;
+ end if;
+
Corr_Type := Base_Type (Corresponding_Record_Type (Obj_Type));
Elmt := First_Elmt (Primitive_Operations (Corr_Type));
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 04413a19602..794a05730e5 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -891,6 +891,37 @@ package body Sem_Ch6 is
end if;
Set_Actual_Subtypes (N, Current_Scope);
+ Process_PPCs (N, Gen_Id, Body_Id);
+
+ -- If the generic unit carries pre- or post-conditions, copy them
+ -- to the original generic tree, so that they are properly added
+ -- to any instantiation.
+
+ declare
+ Orig : constant Node_Id := Original_Node (N);
+ Cond : Node_Id;
+
+ begin
+ Cond := First (Declarations (N));
+ while Present (Cond) loop
+ if Nkind (Cond) = N_Pragma
+ and then Pragma_Name (Cond) = Name_Check
+ then
+ Prepend (New_Copy_Tree (Cond), Declarations (Orig));
+
+ elsif Nkind (Cond) = N_Pragma
+ and then Pragma_Name (Cond) = Name_Postcondition
+ then
+ Set_Ekind (Defining_Entity (Orig), Ekind (Gen_Id));
+ Prepend (New_Copy_Tree (Cond), Declarations (Orig));
+ else
+ exit;
+ end if;
+
+ Next (Cond);
+ end loop;
+ end;
+
Analyze_Declarations (Declarations (N));
Check_Completion;
Analyze (Handled_Statement_Sequence (N));
@@ -1534,8 +1565,14 @@ package body Sem_Ch6 is
-- made by the analysis of the specification and try to find the
-- spec again.
- if No (Spec_N) then
+ -- Note that wrappers already have their corresponding specs and
+ -- bodies set during their creation, so if the candidate spec is
+ -- a wrapper, then we definately need to swap all types to their
+ -- original concurrent status.
+ if No (Spec_N)
+ or else Is_Primitive_Wrapper (Spec_N)
+ then
-- Restore all references of corresponding record types to the
-- original concurrent types.
@@ -1874,6 +1911,10 @@ package body Sem_Ch6 is
end if;
end if;
+ if Chars (Body_Id) = Name_uPostconditions then
+ Set_Has_Postconditions (Current_Scope);
+ end if;
+
-- Place subprogram on scope stack, and make formals visible. If there
-- is a spec, the visible entity remains that of the spec.
@@ -2365,17 +2406,6 @@ package body Sem_Ch6 is
and then No_Return (Ent)
then
Set_Trivial_Subprogram (Stm);
-
- -- If the procedure name is Raise_Exception, then also
- -- assume that it raises an exception. The main target
- -- here is Ada.Exceptions.Raise_Exception, but this name
- -- is pretty evocative in any context! Note that the
- -- procedure in Ada.Exceptions is not marked No_Return
- -- because of the annoying case of the null exception Id
- -- when operating in Ada 95 mode.
-
- elsif Chars (Ent) = Name_Raise_Exception then
- Set_Trivial_Subprogram (Stm);
end if;
end;
end if;
@@ -6564,12 +6594,6 @@ package body Sem_Ch6 is
In_Scope : Boolean;
Typ : Entity_Id;
- function Has_Correct_Formal_Mode
- (Tag_Typ : Entity_Id;
- Subp : Entity_Id) return Boolean;
- -- For an overridden subprogram Subp, check whether the mode of its
- -- first parameter is correct depending on the kind of Tag_Typ.
-
function Matches_Prefixed_View_Profile
(Prim_Params : List_Id;
Iface_Params : List_Id) return Boolean;
@@ -6578,39 +6602,6 @@ package body Sem_Ch6 is
-- Iface_Params. Also determine if the type of first parameter of
-- Iface_Params is an implemented interface.
- -----------------------------
- -- Has_Correct_Formal_Mode --
- -----------------------------
-
- function Has_Correct_Formal_Mode
- (Tag_Typ : Entity_Id;
- Subp : Entity_Id) return Boolean
- is
- Formal : constant Node_Id := First_Formal (Subp);
-
- begin
- -- In order for an entry or a protected procedure to override, the
- -- first parameter of the overridden routine must be of mode
- -- "out", "in out" or access-to-variable.
-
- if (Ekind (Subp) = E_Entry
- or else Ekind (Subp) = E_Procedure)
- and then Is_Protected_Type (Tag_Typ)
- and then Ekind (Formal) /= E_In_Out_Parameter
- and then Ekind (Formal) /= E_Out_Parameter
- and then Nkind (Parameter_Type (Parent (Formal))) /=
- N_Access_Definition
- then
- return False;
- end if;
-
- -- All other cases are OK since a task entry or routine does not
- -- have a restriction on the mode of the first parameter of the
- -- overridden interface routine.
-
- return True;
- end Has_Correct_Formal_Mode;
-
-----------------------------------
-- Matches_Prefixed_View_Profile --
-----------------------------------
@@ -6688,15 +6679,15 @@ package body Sem_Ch6 is
Iface_Id := Defining_Identifier (Iface_Param);
Iface_Typ := Find_Parameter_Type (Iface_Param);
- if Is_Access_Type (Iface_Typ) then
- Iface_Typ := Directly_Designated_Type (Iface_Typ);
- end if;
-
Prim_Id := Defining_Identifier (Prim_Param);
Prim_Typ := Find_Parameter_Type (Prim_Param);
- if Is_Access_Type (Prim_Typ) then
- Prim_Typ := Directly_Designated_Type (Prim_Typ);
+ if Ekind (Iface_Typ) = E_Anonymous_Access_Type
+ and then Ekind (Prim_Typ) = E_Anonymous_Access_Type
+ and then Is_Concurrent_Type (Designated_Type (Prim_Typ))
+ then
+ Iface_Typ := Designated_Type (Iface_Typ);
+ Prim_Typ := Designated_Type (Prim_Typ);
end if;
-- Case of multiple interface types inside a parameter profile
@@ -6829,60 +6820,63 @@ package body Sem_Ch6 is
while Present (Hom) loop
Subp := Hom;
- -- Entries can override abstract or null interface
- -- procedures
-
- if Ekind (Def_Id) = E_Entry
- and then Ekind (Subp) = E_Procedure
- and then Nkind (Parent (Subp)) = N_Procedure_Specification
- and then (Is_Abstract_Subprogram (Subp)
- or else Null_Present (Parent (Subp)))
+ if Subp = Def_Id
+ or else not Is_Overloadable (Subp)
+ or else not Is_Primitive (Subp)
+ or else not Is_Dispatching_Operation (Subp)
+ or else not Is_Interface (Find_Dispatching_Type (Subp))
then
- while Present (Alias (Subp)) loop
- Subp := Alias (Subp);
- end loop;
-
- if Matches_Prefixed_View_Profile
- (Parameter_Specifications (Parent (Def_Id)),
- Parameter_Specifications (Parent (Subp)))
- then
- Candidate := Subp;
-
- -- Absolute match
-
- if Has_Correct_Formal_Mode (Typ, Candidate) then
- Overridden_Subp := Candidate;
- return;
- end if;
- end if;
+ null;
- -- Procedures can override abstract or null interface
- -- procedures
+ -- Entries and procedures can override abstract or null
+ -- interface procedures
- elsif Ekind (Def_Id) = E_Procedure
+ elsif (Ekind (Def_Id) = E_Procedure
+ or else Ekind (Def_Id) = E_Entry)
and then Ekind (Subp) = E_Procedure
- and then Nkind (Parent (Subp)) = N_Procedure_Specification
- and then (Is_Abstract_Subprogram (Subp)
- or else Null_Present (Parent (Subp)))
and then Matches_Prefixed_View_Profile
(Parameter_Specifications (Parent (Def_Id)),
Parameter_Specifications (Parent (Subp)))
then
Candidate := Subp;
- -- Absolute match
+ -- For an overridden subprogram Subp, check whether the mode
+ -- of its first parameter is correct depending on the kind
+ -- of synchronized type.
- if Has_Correct_Formal_Mode (Typ, Candidate) then
- Overridden_Subp := Candidate;
- return;
- end if;
+ declare
+ Formal : constant Node_Id := First_Formal (Candidate);
+
+ begin
+ -- In order for an entry or a protected procedure to
+ -- override, the first parameter of the overridden
+ -- routine must be of mode "out", "in out" or
+ -- access-to-variable.
+
+ if (Ekind (Candidate) = E_Entry
+ or else Ekind (Candidate) = E_Procedure)
+ and then Is_Protected_Type (Typ)
+ and then Ekind (Formal) /= E_In_Out_Parameter
+ and then Ekind (Formal) /= E_Out_Parameter
+ and then Nkind (Parameter_Type (Parent (Formal)))
+ /= N_Access_Definition
+ then
+ null;
+
+ -- All other cases are OK since a task entry or routine
+ -- does not have a restriction on the mode of the first
+ -- parameter of the overridden interface routine.
+
+ else
+ Overridden_Subp := Candidate;
+ return;
+ end if;
+ end;
-- Functions can override abstract interface functions
elsif Ekind (Def_Id) = E_Function
and then Ekind (Subp) = E_Function
- and then Nkind (Parent (Subp)) = N_Function_Specification
- and then Is_Abstract_Subprogram (Subp)
and then Matches_Prefixed_View_Profile
(Parameter_Specifications (Parent (Def_Id)),
Parameter_Specifications (Parent (Subp)))
@@ -7753,8 +7747,17 @@ package body Sem_Ch6 is
-- do this fiddling, for the spec cases, the already preanalyzed
-- parameters are not affected.
+ -- For a postcondition pragma within a generic, preserve the pragma
+ -- for later expansion.
+
Set_Analyzed (CP, False);
+ if Nam = Name_Postcondition
+ and then not Expander_Active
+ then
+ return CP;
+ end if;
+
-- Change pragma into corresponding pragma Check
Prepend_To (Pragma_Argument_Associations (CP),
@@ -7772,6 +7775,12 @@ package body Sem_Ch6 is
-- Start of processing for Process_PPCs
begin
+ -- Nothing to do if we are not generating code
+
+ if Operating_Mode /= Generate_Code then
+ return;
+ end if;
+
-- Grab preconditions from spec
if Present (Spec_Id) then
@@ -7827,7 +7836,15 @@ package body Sem_Ch6 is
end if;
Analyze (Prag);
- Append (Grab_PPC (Name_Postcondition), Plist);
+
+ -- If expansion is disabled, as in a generic unit,
+ -- save pragma for later expansion.
+
+ if not Expander_Active then
+ Prepend (Grab_PPC (Name_Postcondition), Declarations (N));
+ else
+ Append (Grab_PPC (Name_Postcondition), Plist);
+ end if;
end if;
Next (Prag);
@@ -7860,16 +7877,23 @@ package body Sem_Ch6 is
Plist := Empty_List;
end if;
- Append (Grab_PPC (Name_Postcondition), Plist);
+ if not Expander_Active then
+ Prepend (Grab_PPC (Name_Postcondition), Declarations (N));
+ else
+ Append (Grab_PPC (Name_Postcondition), Plist);
+ end if;
end if;
Prag := Next_Pragma (Prag);
end loop;
end if;
- -- If we had any postconditions, build the procedure
+ -- If we had any postconditions and expansion is enabled, build
+ -- the Postconditions procedure.
- if Present (Plist) then
+ if Present (Plist)
+ and then Expander_Active
+ then
Subp := Defining_Entity (N);
if Etype (Subp) /= Standard_Void_Type then
diff --git a/gcc/ada/sem_mech.adb b/gcc/ada/sem_mech.adb
index 177a39ca671..87a0d054451 100644
--- a/gcc/ada/sem_mech.adb
+++ b/gcc/ada/sem_mech.adb
@@ -69,7 +69,7 @@ package body Sem_Mech is
("mechanism for & has already been set", Mech_Name, Ent);
end if;
- -- MECHANISM_NAME ::= value | reference | descriptor
+ -- MECHANISM_NAME ::= value | reference | descriptor | short_descriptor
if Nkind (Mech_Name) = N_Identifier then
if Chars (Mech_Name) = Name_Value then
@@ -85,6 +85,11 @@ package body Sem_Mech is
Set_Mechanism_With_Checks (Ent, By_Descriptor, Mech_Name);
return;
+ elsif Chars (Mech_Name) = Name_Short_Descriptor then
+ Check_VMS (Mech_Name);
+ Set_Mechanism_With_Checks (Ent, By_Short_Descriptor, Mech_Name);
+ return;
+
elsif Chars (Mech_Name) = Name_Copy then
Error_Msg_N
("bad mechanism name, Value assumed", Mech_Name);
@@ -95,7 +100,8 @@ package body Sem_Mech is
return;
end if;
- -- MECHANISM_NAME ::= descriptor (CLASS_NAME)
+ -- MECHANISM_NAME ::= descriptor (CLASS_NAME) |
+ -- short_descriptor (CLASS_NAME)
-- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
-- Note: this form is parsed as an indexed component
@@ -104,14 +110,16 @@ package body Sem_Mech is
Class := First (Expressions (Mech_Name));
if Nkind (Prefix (Mech_Name)) /= N_Identifier
- or else Chars (Prefix (Mech_Name)) /= Name_Descriptor
+ or else not (Chars (Prefix (Mech_Name)) = Name_Descriptor or else
+ Chars (Prefix (Mech_Name)) = Name_Short_Descriptor)
or else Present (Next (Class))
then
Bad_Mechanism;
return;
end if;
- -- MECHANISM_NAME ::= descriptor (Class => CLASS_NAME)
+ -- MECHANISM_NAME ::= descriptor (Class => CLASS_NAME) |
+ -- short_descriptor (Class => CLASS_NAME)
-- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
-- Note: this form is parsed as a function call
@@ -121,7 +129,8 @@ package body Sem_Mech is
Param := First (Parameter_Associations (Mech_Name));
if Nkind (Name (Mech_Name)) /= N_Identifier
- or else Chars (Name (Mech_Name)) /= Name_Descriptor
+ or else not (Chars (Name (Mech_Name)) = Name_Descriptor or else
+ Chars (Name (Mech_Name)) = Name_Short_Descriptor)
or else Present (Next (Param))
or else No (Selector_Name (Param))
or else Chars (Selector_Name (Param)) /= Name_Class
@@ -145,27 +154,76 @@ package body Sem_Mech is
Bad_Class;
return;
- elsif Chars (Class) = Name_UBS then
+ elsif Chars (Name (Mech_Name)) = Name_Descriptor
+ and then Chars (Class) = Name_UBS
+ then
Set_Mechanism_With_Checks (Ent, By_Descriptor_UBS, Mech_Name);
- elsif Chars (Class) = Name_UBSB then
+ elsif Chars (Name (Mech_Name)) = Name_Descriptor
+ and then Chars (Class) = Name_UBSB
+ then
Set_Mechanism_With_Checks (Ent, By_Descriptor_UBSB, Mech_Name);
- elsif Chars (Class) = Name_UBA then
+ elsif Chars (Name (Mech_Name)) = Name_Descriptor
+ and then Chars (Class) = Name_UBA
+ then
Set_Mechanism_With_Checks (Ent, By_Descriptor_UBA, Mech_Name);
- elsif Chars (Class) = Name_S then
+ elsif Chars (Name (Mech_Name)) = Name_Descriptor
+ and then Chars (Class) = Name_S
+ then
Set_Mechanism_With_Checks (Ent, By_Descriptor_S, Mech_Name);
- elsif Chars (Class) = Name_SB then
+ elsif Chars (Name (Mech_Name)) = Name_Descriptor
+ and then Chars (Class) = Name_SB
+ then
Set_Mechanism_With_Checks (Ent, By_Descriptor_SB, Mech_Name);
- elsif Chars (Class) = Name_A then
+ elsif Chars (Name (Mech_Name)) = Name_Descriptor
+ and then Chars (Class) = Name_A
+ then
Set_Mechanism_With_Checks (Ent, By_Descriptor_A, Mech_Name);
- elsif Chars (Class) = Name_NCA then
+ elsif Chars (Name (Mech_Name)) = Name_Descriptor
+ and then Chars (Class) = Name_NCA
+ then
Set_Mechanism_With_Checks (Ent, By_Descriptor_NCA, Mech_Name);
+ elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
+ and then Chars (Class) = Name_UBS
+ then
+ Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_UBS, Mech_Name);
+
+ elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
+ and then Chars (Class) = Name_UBSB
+ then
+ Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_UBSB, Mech_Name);
+
+ elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
+ and then Chars (Class) = Name_UBA
+ then
+ Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_UBA, Mech_Name);
+
+ elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
+ and then Chars (Class) = Name_S
+ then
+ Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_S, Mech_Name);
+
+ elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
+ and then Chars (Class) = Name_SB
+ then
+ Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_SB, Mech_Name);
+
+ elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
+ and then Chars (Class) = Name_A
+ then
+ Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_A, Mech_Name);
+
+ elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
+ and then Chars (Class) = Name_NCA
+ then
+ Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_NCA, Mech_Name);
+
else
Bad_Class;
return;
diff --git a/gcc/ada/sem_mech.ads b/gcc/ada/sem_mech.ads
index 1673a671b0e..93f6080f1f4 100644
--- a/gcc/ada/sem_mech.ads
+++ b/gcc/ada/sem_mech.ads
@@ -95,6 +95,14 @@ package Sem_Mech is
By_Descriptor_SB : constant Mechanism_Type := -8;
By_Descriptor_A : constant Mechanism_Type := -9;
By_Descriptor_NCA : constant Mechanism_Type := -10;
+ By_Short_Descriptor : constant Mechanism_Type := -11;
+ By_Short_Descriptor_UBS : constant Mechanism_Type := -12;
+ By_Short_Descriptor_UBSB : constant Mechanism_Type := -13;
+ By_Short_Descriptor_UBA : constant Mechanism_Type := -14;
+ By_Short_Descriptor_S : constant Mechanism_Type := -15;
+ By_Short_Descriptor_SB : constant Mechanism_Type := -16;
+ By_Short_Descriptor_A : constant Mechanism_Type := -17;
+ By_Short_Descriptor_NCA : constant Mechanism_Type := -18;
-- These values are used only in OpenVMS ports of GNAT. Pass by descriptor
-- is forced, as described in the OpenVMS ABI. The suffix indicates the
-- descriptor type:
@@ -113,7 +121,7 @@ package Sem_Mech is
-- type based on the Ada type in accordance with the OpenVMS ABI.
subtype Descriptor_Codes is Mechanism_Type
- range By_Descriptor_NCA .. By_Descriptor;
+ range By_Short_Descriptor_NCA .. By_Descriptor;
-- Subtype including all descriptor mechanisms
-- All the above special values are non-positive. Positive values for
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 3feba8002d9..f62d6c8944a 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -53,6 +53,7 @@ with Sem_Aux; use Sem_Aux;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
+with Sem_Ch12; use Sem_Ch12;
with Sem_Ch13; use Sem_Ch13;
with Sem_Dist; use Sem_Dist;
with Sem_Elim; use Sem_Elim;
@@ -583,6 +584,7 @@ package body Sem_Prag is
-- expression, returns True if so, False if non-static or not String.
procedure Pragma_Misplaced;
+ pragma No_Return (Pragma_Misplaced);
-- Issue fatal error message for misplaced pragma
procedure Process_Atomic_Shared_Volatile;
@@ -1350,9 +1352,57 @@ package body Sem_Prag is
procedure Check_Precondition_Postcondition (In_Body : out Boolean) is
P : Node_Id;
- S : Entity_Id;
PO : Node_Id;
+ procedure Chain_PPC (PO : Node_Id);
+ -- If PO is a subprogram declaration node (or a generic subprogram
+ -- declaration node), then the precondition/postcondition applies
+ -- to this subprogram and the processing for the pragma is completed.
+ -- Otherwise the pragma is misplaced.
+
+ ---------------
+ -- Chain_PPC --
+ ---------------
+
+ procedure Chain_PPC (PO : Node_Id) is
+ S : Node_Id;
+
+ begin
+ if not Nkind_In (PO, N_Subprogram_Declaration,
+ N_Generic_Subprogram_Declaration)
+ then
+ Pragma_Misplaced;
+ end if;
+
+ -- Here if we have subprogram or generic subprogram declaration
+
+ S := Defining_Unit_Name (Specification (PO));
+
+ -- Analyze the pragma unless it appears within a package spec,
+ -- which is the case where we delay the analysis of the PPC until
+ -- the end of the package declarations (for details, see
+ -- Analyze_Package_Specification.Analyze_PPCs).
+
+ if Ekind (Scope (S)) /= E_Package
+ and then
+ Ekind (Scope (S)) /= E_Generic_Package
+ then
+ Analyze_PPC_In_Decl_Part (N, S);
+ end if;
+
+ -- Chain spec PPC pragma to list for subprogram
+
+ Set_Next_Pragma (N, Spec_PPC_List (S));
+ Set_Spec_PPC_List (S, N);
+
+ -- Return indicating spec case
+
+ In_Body := False;
+ return;
+ end Chain_PPC;
+
+ -- Start of processing for Check_Precondition_Postcondition
+
begin
if not Is_List_Member (N) then
Pragma_Misplaced;
@@ -1362,6 +1412,14 @@ package body Sem_Prag is
Set_PPC_Enabled (N, Check_Enabled (Pname));
+ -- If we are within an inlined body, the legality of the pragma
+ -- has been checked already.
+
+ if In_Inlined_Body then
+ In_Body := True;
+ return;
+ end if;
+
-- Search prior declarations
P := N;
@@ -1379,37 +1437,11 @@ package body Sem_Prag is
elsif not Comes_From_Source (PO) then
null;
- -- Here if we hit a subprogram declaration
-
- elsif Nkind (PO) = N_Subprogram_Declaration then
- S := Defining_Unit_Name (Specification (PO));
-
- -- Analyze the pragma unless it appears within a package spec,
- -- which is the case where we delay the analysis of the PPC
- -- until the end of the package declarations (for details,
- -- see Analyze_Package_Specification.Analyze_PPCs).
-
- if Ekind (Scope (S)) /= E_Package
- and then
- Ekind (Scope (S)) /= E_Generic_Package
- then
- Analyze_PPC_In_Decl_Part (N, S);
- end if;
-
- -- Chain spec PPC pragma to list for subprogram
-
- Set_Next_Pragma (N, Spec_PPC_List (S));
- Set_Spec_PPC_List (S, N);
-
- -- Return indicating spec case
-
- In_Body := False;
- return;
-
- -- If we encounter any other declaration moving back, misplaced
+ -- Only remaining possibility is subprogram declaration
else
- Pragma_Misplaced;
+ Chain_PPC (PO);
+ return;
end if;
end loop;
@@ -1419,14 +1451,28 @@ package body Sem_Prag is
if Nkind (Parent (N)) = N_Subprogram_Body
and then List_Containing (N) = Declarations (Parent (N))
then
+ if Operating_Mode /= Generate_Code then
+
+ -- Analyze expression in pragma, for correctness
+ -- and for ASIS use.
+
+ Preanalyze_Spec_Expression
+ (Get_Pragma_Arg (Arg1), Standard_Boolean);
+ end if;
+
In_Body := True;
return;
- -- If not, it was misplaced
+ -- See if it is in the pragmas after a library level subprogram
- else
- Pragma_Misplaced;
+ elsif Nkind (Parent (N)) = N_Compilation_Unit_Aux then
+ Chain_PPC (Unit (Parent (Parent (N))));
+ return;
end if;
+
+ -- If we fall through, pragma was misplaced
+
+ Pragma_Misplaced;
end Check_Precondition_Postcondition;
-----------------------------
@@ -2185,7 +2231,6 @@ package body Sem_Prag is
Arg1x : constant Node_Id := Get_Pragma_Arg (Arg1);
begin
- GNAT_Pragma;
Check_Arg_Count (2);
Check_No_Identifiers;
Check_Arg_Is_Static_Expression (Arg2, Standard_String);
@@ -2602,8 +2647,6 @@ package body Sem_Prag is
Code_Val : Uint;
begin
- GNAT_Pragma;
-
if not OpenVMS_On_Target then
Error_Pragma
("?pragma% ignored (applies only to Open'V'M'S)");
@@ -2661,8 +2704,6 @@ package body Sem_Prag is
(Arg_Internal : Node_Id := Empty)
is
begin
- GNAT_Pragma;
-
if No (Arg_Internal) then
Error_Pragma ("Internal parameter required for pragma%");
end if;
@@ -3279,7 +3320,6 @@ package body Sem_Prag is
Exp : Node_Id;
begin
- GNAT_Pragma;
Check_No_Identifiers;
Check_At_Least_N_Arguments (1);
@@ -3716,6 +3756,22 @@ package body Sem_Prag is
and then Present (Corresponding_Body (Decl))
then
Set_Inline_Flags (Corresponding_Body (Decl));
+
+ elsif Is_Generic_Instance (Subp) then
+
+ -- Indicate that the body needs to be created for
+ -- inlining subsequent calls. The instantiation
+ -- node follows the declaration of the wrapper
+ -- package created for it.
+
+ if Scope (Subp) /= Standard_Standard
+ and then
+ Need_Subprogram_Instance_Body
+ (Next (Unit_Declaration_Node (Scope (Alias (Subp)))),
+ Subp)
+ then
+ null;
+ end if;
end if;
end if;
@@ -3834,17 +3890,23 @@ package body Sem_Prag is
Link_Nam : Node_Id;
String_Val : String_Id;
- procedure Check_Form_Of_Interface_Name (SN : Node_Id);
+ procedure Check_Form_Of_Interface_Name
+ (SN : Node_Id;
+ Ext_Name_Case : Boolean);
-- SN is a string literal node for an interface name. This routine
-- performs some minimal checks that the name is reasonable. In
-- particular that no spaces or other obviously incorrect characters
-- appear. This is only a warning, since any characters are allowed.
+ -- Ext_Name_Case is True for an External_Name, False for a Link_Name.
----------------------------------
-- Check_Form_Of_Interface_Name --
----------------------------------
- procedure Check_Form_Of_Interface_Name (SN : Node_Id) is
+ procedure Check_Form_Of_Interface_Name
+ (SN : Node_Id;
+ Ext_Name_Case : Boolean)
+ is
S : constant String_Id := Strval (Expr_Value_S (SN));
SL : constant Nat := String_Length (S);
C : Char_Code;
@@ -3857,15 +3919,31 @@ package body Sem_Prag is
for J in 1 .. SL loop
C := Get_String_Char (S, J);
- if Warn_On_Export_Import
- and then
- (not In_Character_Range (C)
- or else (Get_Character (C) = ' '
- and then VM_Target /= CLI_Target)
- or else Get_Character (C) = ',')
+ -- Look for dubious character and issue unconditional warning.
+ -- Definitely dubious if not in character range.
+
+ if not In_Character_Range (C)
+
+ -- Dubious if comma
+
+ or else Get_Character (C) = ','
+
+ -- For all cases except link names on a CLI target, spaces
+ -- and slashes are also dubious (in CLI for link names, we
+ -- use spaces and possibly slashes for special purposes).
+
+ -- Where is this usage documented ???
+
+ or else ((Ext_Name_Case or else VM_Target /= CLI_Target)
+ and then (Get_Character (C) = ' '
+ or else
+ Get_Character (C) = '/'
+ or else
+ Get_Character (C) = '\'))
then
- Error_Msg_N
- ("?interface name contains illegal character", SN);
+ Error_Msg
+ ("?interface name contains illegal character",
+ Sloc (SN) + Source_Ptr (J));
end if;
end loop;
end Check_Form_Of_Interface_Name;
@@ -3910,13 +3988,13 @@ package body Sem_Prag is
if Present (Ext_Nam) then
Check_Arg_Is_Static_Expression (Ext_Nam, Standard_String);
- Check_Form_Of_Interface_Name (Ext_Nam);
+ Check_Form_Of_Interface_Name (Ext_Nam, Ext_Name_Case => True);
- -- Verify that the external name is not the name of a local
- -- entity, which would hide the imported one and lead to
- -- run-time surprises. The problem can only arise for entities
- -- declared in a package body (otherwise the external name is
- -- fully qualified and won't conflict).
+ -- Verify that external name is not the name of a local entity,
+ -- which would hide the imported one and could lead to run-time
+ -- surprises. The problem can only arise for entities declared in
+ -- a package body (otherwise the external name is fully qualified
+ -- and will not conflict).
declare
Nam : Name_Id;
@@ -3939,10 +4017,10 @@ package body Sem_Prag is
Par := Parent (E);
while Present (Par) loop
if Nkind (Par) = N_Package_Body then
- Error_Msg_Sloc := Sloc (E);
+ Error_Msg_Sloc := Sloc (E);
Error_Msg_NE
("imported entity is hidden by & declared#",
- Ext_Arg, E);
+ Ext_Arg, E);
exit;
end if;
@@ -3955,7 +4033,7 @@ package body Sem_Prag is
if Present (Link_Nam) then
Check_Arg_Is_Static_Expression (Link_Nam, Standard_String);
- Check_Form_Of_Interface_Name (Link_Nam);
+ Check_Form_Of_Interface_Name (Link_Nam, Ext_Name_Case => False);
end if;
-- If there is no link name, just set the external name
@@ -4586,6 +4664,7 @@ package body Sem_Prag is
procedure Set_Mechanism_Value (Ent : Entity_Id; Mech_Name : Node_Id) is
Class : Node_Id;
Param : Node_Id;
+ Mech_Name_Id : Name_Id;
procedure Bad_Class;
-- Signal bad descriptor class name
@@ -4619,7 +4698,8 @@ package body Sem_Prag is
("mechanism for & has already been set", Mech_Name, Ent);
end if;
- -- MECHANISM_NAME ::= value | reference | descriptor
+ -- MECHANISM_NAME ::= value | reference | descriptor |
+ -- short_descriptor
if Nkind (Mech_Name) = N_Identifier then
if Chars (Mech_Name) = Name_Value then
@@ -4635,6 +4715,11 @@ package body Sem_Prag is
Set_Mechanism (Ent, By_Descriptor);
return;
+ elsif Chars (Mech_Name) = Name_Short_Descriptor then
+ Check_VMS (Mech_Name);
+ Set_Mechanism (Ent, By_Short_Descriptor);
+ return;
+
elsif Chars (Mech_Name) = Name_Copy then
Error_Pragma_Arg
("bad mechanism name, Value assumed", Mech_Name);
@@ -4643,22 +4728,28 @@ package body Sem_Prag is
Bad_Mechanism;
end if;
- -- MECHANISM_NAME ::= descriptor (CLASS_NAME)
+ -- MECHANISM_NAME ::= descriptor (CLASS_NAME) |
+ -- short_descriptor (CLASS_NAME)
-- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
-- Note: this form is parsed as an indexed component
elsif Nkind (Mech_Name) = N_Indexed_Component then
+
Class := First (Expressions (Mech_Name));
if Nkind (Prefix (Mech_Name)) /= N_Identifier
- or else Chars (Prefix (Mech_Name)) /= Name_Descriptor
- or else Present (Next (Class))
+ or else not (Chars (Prefix (Mech_Name)) = Name_Descriptor or else
+ Chars (Prefix (Mech_Name)) = Name_Short_Descriptor)
+ or else Present (Next (Class))
then
Bad_Mechanism;
+ else
+ Mech_Name_Id := Chars (Prefix (Mech_Name));
end if;
- -- MECHANISM_NAME ::= descriptor (Class => CLASS_NAME)
+ -- MECHANISM_NAME ::= descriptor (Class => CLASS_NAME) |
+ -- short_descriptor (Class => CLASS_NAME)
-- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
-- Note: this form is parsed as a function call
@@ -4668,7 +4759,8 @@ package body Sem_Prag is
Param := First (Parameter_Associations (Mech_Name));
if Nkind (Name (Mech_Name)) /= N_Identifier
- or else Chars (Name (Mech_Name)) /= Name_Descriptor
+ or else not (Chars (Name (Mech_Name)) = Name_Descriptor or else
+ Chars (Name (Mech_Name)) = Name_Short_Descriptor)
or else Present (Next (Param))
or else No (Selector_Name (Param))
or else Chars (Selector_Name (Param)) /= Name_Class
@@ -4676,6 +4768,7 @@ package body Sem_Prag is
Bad_Mechanism;
else
Class := Explicit_Actual_Parameter (Param);
+ Mech_Name_Id := Chars (Name (Mech_Name));
end if;
else
@@ -4689,27 +4782,76 @@ package body Sem_Prag is
if Nkind (Class) /= N_Identifier then
Bad_Class;
- elsif Chars (Class) = Name_UBS then
+ elsif Mech_Name_Id = Name_Descriptor
+ and then Chars (Class) = Name_UBS
+ then
Set_Mechanism (Ent, By_Descriptor_UBS);
- elsif Chars (Class) = Name_UBSB then
+ elsif Mech_Name_Id = Name_Descriptor
+ and then Chars (Class) = Name_UBSB
+ then
Set_Mechanism (Ent, By_Descriptor_UBSB);
- elsif Chars (Class) = Name_UBA then
+ elsif Mech_Name_Id = Name_Descriptor
+ and then Chars (Class) = Name_UBA
+ then
Set_Mechanism (Ent, By_Descriptor_UBA);
- elsif Chars (Class) = Name_S then
+ elsif Mech_Name_Id = Name_Descriptor
+ and then Chars (Class) = Name_S
+ then
Set_Mechanism (Ent, By_Descriptor_S);
- elsif Chars (Class) = Name_SB then
+ elsif Mech_Name_Id = Name_Descriptor
+ and then Chars (Class) = Name_SB
+ then
Set_Mechanism (Ent, By_Descriptor_SB);
- elsif Chars (Class) = Name_A then
+ elsif Mech_Name_Id = Name_Descriptor
+ and then Chars (Class) = Name_A
+ then
Set_Mechanism (Ent, By_Descriptor_A);
- elsif Chars (Class) = Name_NCA then
+ elsif Mech_Name_Id = Name_Descriptor
+ and then Chars (Class) = Name_NCA
+ then
Set_Mechanism (Ent, By_Descriptor_NCA);
+ elsif Mech_Name_Id = Name_Short_Descriptor
+ and then Chars (Class) = Name_UBS
+ then
+ Set_Mechanism (Ent, By_Short_Descriptor_UBS);
+
+ elsif Mech_Name_Id = Name_Short_Descriptor
+ and then Chars (Class) = Name_UBSB
+ then
+ Set_Mechanism (Ent, By_Short_Descriptor_UBSB);
+
+ elsif Mech_Name_Id = Name_Short_Descriptor
+ and then Chars (Class) = Name_UBA
+ then
+ Set_Mechanism (Ent, By_Short_Descriptor_UBA);
+
+ elsif Mech_Name_Id = Name_Short_Descriptor
+ and then Chars (Class) = Name_S
+ then
+ Set_Mechanism (Ent, By_Short_Descriptor_S);
+
+ elsif Mech_Name_Id = Name_Short_Descriptor
+ and then Chars (Class) = Name_SB
+ then
+ Set_Mechanism (Ent, By_Short_Descriptor_SB);
+
+ elsif Mech_Name_Id = Name_Short_Descriptor
+ and then Chars (Class) = Name_A
+ then
+ Set_Mechanism (Ent, By_Short_Descriptor_A);
+
+ elsif Mech_Name_Id = Name_Short_Descriptor
+ and then Chars (Class) = Name_NCA
+ then
+ Set_Mechanism (Ent, By_Short_Descriptor_NCA);
+
else
Bad_Class;
end if;
@@ -5667,11 +5809,11 @@ package body Sem_Prag is
-- pragma Comment (static_string_EXPRESSION)
- -- Processing for pragma Comment shares the circuitry for
- -- pragma Ident. The only differences are that Ident enforces
- -- a limit of 31 characters on its argument, and also enforces
- -- limitations on placement for DEC compatibility. Pragma
- -- Comment shares neither of these restrictions.
+ -- Processing for pragma Comment shares the circuitry for pragma
+ -- Ident. The only differences are that Ident enforces a limit of 31
+ -- characters on its argument, and also enforces limitations on
+ -- placement for DEC compatibility. Pragma Comment shares neither of
+ -- these restrictions.
-------------------
-- Common_Object --
@@ -5692,6 +5834,7 @@ package body Sem_Prag is
-- (boolean_EXPRESSION, static_string_EXPRESSION);
when Pragma_Compile_Time_Error =>
+ GNAT_Pragma;
Process_Compile_Time_Warning_Or_Error;
--------------------------
@@ -5702,6 +5845,7 @@ package body Sem_Prag is
-- (boolean_EXPRESSION, static_string_EXPRESSION);
when Pragma_Compile_Time_Warning =>
+ GNAT_Pragma;
Process_Compile_Time_Warning_Or_Error;
-------------------
@@ -6076,6 +6220,8 @@ package body Sem_Prag is
when Pragma_CPP_Virtual => CPP_Virtual : declare
begin
+ GNAT_Pragma;
+
if Warn_On_Obsolescent_Feature then
Error_Msg_N
("'G'N'A'T pragma cpp'_virtual is now obsolete and has " &
@@ -6089,6 +6235,8 @@ package body Sem_Prag is
when Pragma_CPP_Vtable => CPP_Vtable : declare
begin
+ GNAT_Pragma;
+
if Warn_On_Obsolescent_Feature then
Error_Msg_N
("'G'N'A'T pragma cpp'_vtable is now obsolete and has " &
@@ -6608,6 +6756,8 @@ package body Sem_Prag is
Code : Node_Id renames Args (4);
begin
+ GNAT_Pragma;
+
if Inside_A_Generic then
Error_Pragma ("pragma% cannot be used for generic entities");
end if;
@@ -7077,6 +7227,7 @@ package body Sem_Prag is
Typ : Entity_Id;
begin
+ GNAT_Pragma;
Check_No_Identifiers;
Check_Arg_Count (1);
Check_Arg_Is_Local_Name (Arg1);
@@ -7410,6 +7561,7 @@ package body Sem_Prag is
Code : Node_Id renames Args (4);
begin
+ GNAT_Pragma;
Gather_Associations (Names, Args);
if Present (External) and then Present (Code) then
@@ -7695,6 +7847,7 @@ package body Sem_Prag is
-- pragma Inline_Always ( NAME {, NAME} );
when Pragma_Inline_Always =>
+ GNAT_Pragma;
Process_Inline (True);
--------------------
@@ -7704,6 +7857,7 @@ package body Sem_Prag is
-- pragma Inline_Generic (NAME {, NAME});
when Pragma_Inline_Generic =>
+ GNAT_Pragma;
Process_Generic_List;
----------------------
@@ -8734,6 +8888,7 @@ package body Sem_Prag is
-- it was misplaced.
when Pragma_No_Body =>
+ GNAT_Pragma;
Pragma_Misplaced;
---------------
@@ -8800,13 +8955,43 @@ package body Sem_Prag is
end loop;
end No_Return;
+ -----------------
+ -- No_Run_Time --
+ -----------------
+
+ -- pragma No_Run_Time;
+
+ -- Note: this pragma is retained for backwards compatibility.
+ -- See body of Rtsfind for full details on its handling.
+
+ when Pragma_No_Run_Time =>
+ GNAT_Pragma;
+ Check_Valid_Configuration_Pragma;
+ Check_Arg_Count (0);
+
+ No_Run_Time_Mode := True;
+ Configurable_Run_Time_Mode := True;
+
+ -- Set Duration to 32 bits if word size is 32
+
+ if Ttypes.System_Word_Size = 32 then
+ Duration_32_Bits_On_Target := True;
+ end if;
+
+ -- Set appropriate restrictions
+
+ Set_Restriction (No_Finalization, N);
+ Set_Restriction (No_Exception_Handlers, N);
+ Set_Restriction (Max_Tasks, N, 0);
+ Set_Restriction (No_Tasking, N);
+
------------------------
-- No_Strict_Aliasing --
------------------------
-- pragma No_Strict_Aliasing [([Entity =>] type_LOCAL_NAME)];
- when Pragma_No_Strict_Aliasing => No_Strict_Alias : declare
+ when Pragma_No_Strict_Aliasing => No_Strict_Aliasing : declare
E_Id : Entity_Id;
begin
@@ -8830,7 +9015,20 @@ package body Sem_Prag is
Set_No_Strict_Aliasing (Implementation_Base_Type (E_Id));
end if;
- end No_Strict_Alias;
+ end No_Strict_Aliasing;
+
+ -----------------------
+ -- Normalize_Scalars --
+ -----------------------
+
+ -- pragma Normalize_Scalars;
+
+ when Pragma_Normalize_Scalars =>
+ Check_Ada_83_Warning;
+ Check_Arg_Count (0);
+ Check_Valid_Configuration_Pragma;
+ Normalize_Scalars := True;
+ Init_Or_Norm_Scalars := True;
-----------------
-- Obsolescent --
@@ -9038,49 +9236,6 @@ package body Sem_Prag is
end if;
end Obsolescent;
- -----------------
- -- No_Run_Time --
- -----------------
-
- -- pragma No_Run_Time
-
- -- Note: this pragma is retained for backwards compatibility.
- -- See body of Rtsfind for full details on its handling.
-
- when Pragma_No_Run_Time =>
- GNAT_Pragma;
- Check_Valid_Configuration_Pragma;
- Check_Arg_Count (0);
-
- No_Run_Time_Mode := True;
- Configurable_Run_Time_Mode := True;
-
- -- Set Duration to 32 bits if word size is 32
-
- if Ttypes.System_Word_Size = 32 then
- Duration_32_Bits_On_Target := True;
- end if;
-
- -- Set appropriate restrictions
-
- Set_Restriction (No_Finalization, N);
- Set_Restriction (No_Exception_Handlers, N);
- Set_Restriction (Max_Tasks, N, 0);
- Set_Restriction (No_Tasking, N);
-
- -----------------------
- -- Normalize_Scalars --
- -----------------------
-
- -- pragma Normalize_Scalars;
-
- when Pragma_Normalize_Scalars =>
- Check_Ada_83_Warning;
- Check_Arg_Count (0);
- Check_Valid_Configuration_Pragma;
- Normalize_Scalars := True;
- Init_Or_Norm_Scalars := True;
-
--------------
-- Optimize --
--------------
@@ -9317,19 +9472,6 @@ package body Sem_Prag is
end if;
end Preelab_Init;
- -------------
- -- Polling --
- -------------
-
- -- pragma Polling (ON | OFF);
-
- when Pragma_Polling =>
- GNAT_Pragma;
- Check_Arg_Count (1);
- Check_No_Identifiers;
- Check_Arg_Is_One_Of (Arg1, Name_On, Name_Off);
- Polling_Required := (Chars (Expression (Arg1)) = Name_On);
-
--------------------
-- Persistent_BSS --
--------------------
@@ -9388,6 +9530,19 @@ package body Sem_Prag is
end if;
end Persistent_BSS;
+ -------------
+ -- Polling --
+ -------------
+
+ -- pragma Polling (ON | OFF);
+
+ when Pragma_Polling =>
+ GNAT_Pragma;
+ Check_Arg_Count (1);
+ Check_No_Identifiers;
+ Check_Arg_Is_One_Of (Arg1, Name_On, Name_Off);
+ Polling_Required := (Chars (Expression (Arg1)) = Name_On);
+
-------------------
-- Postcondition --
-------------------
@@ -10904,6 +11059,7 @@ package body Sem_Prag is
-- or the identifier GCC, no other identifiers are acceptable.
when Pragma_System_Name =>
+ GNAT_Pragma;
Check_No_Identifiers;
Check_Arg_Count (1);
Check_Arg_Is_One_Of (Arg1, Name_Gcc, Name_Gnat);
@@ -11152,7 +11308,7 @@ package body Sem_Prag is
Variant : Node_Id;
begin
- GNAT_Pragma;
+ Ada_2005_Pragma;
Check_No_Identifiers;
Check_Arg_Count (1);
Check_Arg_Is_Local_Name (Arg1);
@@ -11519,7 +11675,7 @@ package body Sem_Prag is
-- pragma Unsuppress (IDENTIFIER [, [On =>] NAME]);
when Pragma_Unsuppress =>
- GNAT_Pragma;
+ Ada_2005_Pragma;
Process_Suppress_Unsuppress (False);
-------------------
@@ -11843,6 +11999,7 @@ package body Sem_Prag is
-- pragma Wide_Character_Encoding (IDENTIFIER);
when Pragma_Wide_Character_Encoding =>
+ GNAT_Pragma;
-- Nothing to do, handled in parser. Note that we do not enforce
-- configuration pragma placement, this pragma can appear at any
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index a6d42f73637..7a767a39179 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -754,7 +754,22 @@ package body Sem_Res is
C := N;
loop
P := Parent (C);
+
+ -- If no parent, then we were not inside a subprogram, this can for
+ -- example happen when processing certain pragmas in a spec. Just
+ -- return False in this case.
+
+ if No (P) then
+ return False;
+ end if;
+
+ -- Done if we get to subprogram body, this is definitely an infinite
+ -- recursion case if we did not find anything to stop us.
+
exit when Nkind (P) = N_Subprogram_Body;
+
+ -- If appearing in conditional, result is false
+
if Nkind_In (P, N_Or_Else,
N_And_Then,
N_If_Statement,
@@ -3218,16 +3233,48 @@ package body Sem_Res is
-- or because it is a generic actual, so use base type to
-- locate concurrent type.
- if Is_Concurrent_Type (Etype (A))
- and then Etype (F) =
- Corresponding_Record_Type (Base_Type (Etype (A)))
- then
- Rewrite (A,
- Unchecked_Convert_To
- (Corresponding_Record_Type (Etype (A)), A));
- end if;
+ A_Typ := Base_Type (Etype (A));
+ F_Typ := Base_Type (Etype (F));
+
+ declare
+ Full_A_Typ : Entity_Id;
- Resolve (A, Etype (F));
+ begin
+ if Present (Full_View (A_Typ)) then
+ Full_A_Typ := Base_Type (Full_View (A_Typ));
+ else
+ Full_A_Typ := A_Typ;
+ end if;
+
+ -- Tagged synchronized type (case 1): the actual is a
+ -- concurrent type
+
+ if Is_Concurrent_Type (A_Typ)
+ and then Corresponding_Record_Type (A_Typ) = F_Typ
+ then
+ Rewrite (A,
+ Unchecked_Convert_To
+ (Corresponding_Record_Type (A_Typ), A));
+ Resolve (A, Etype (F));
+
+ -- Tagged synchronized type (case 2): the formal is a
+ -- concurrent type
+
+ elsif Ekind (Full_A_Typ) = E_Record_Type
+ and then Present
+ (Corresponding_Concurrent_Type (Full_A_Typ))
+ and then Is_Concurrent_Type (F_Typ)
+ and then Present (Corresponding_Record_Type (F_Typ))
+ and then Full_A_Typ = Corresponding_Record_Type (F_Typ)
+ then
+ Resolve (A, Corresponding_Record_Type (F_Typ));
+
+ -- Common case
+
+ else
+ Resolve (A, Etype (F));
+ end if;
+ end;
end if;
A_Typ := Etype (A);
diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index 4a170d82ce3..aae54d1f67e 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -2106,11 +2106,18 @@ package body Sem_Type is
-- to check whether it is a proper descendant.
or else
- (Is_Concurrent_Type (Etype (N))
+ (Is_Record_Type (Typ)
+ and then Is_Concurrent_Type (Etype (N))
and then Present (Corresponding_Record_Type (Etype (N)))
and then Covers (Typ, Corresponding_Record_Type (Etype (N))))
or else
+ (Is_Concurrent_Type (Typ)
+ and then Is_Record_Type (Etype (N))
+ and then Present (Corresponding_Record_Type (Typ))
+ and then Covers (Corresponding_Record_Type (Typ), Etype (N)))
+
+ or else
(not Is_Tagged_Type (Typ)
and then Ekind (Typ) /= E_Anonymous_Access_Type
and then Covers (Etype (N), Typ));
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 64d5cfb674b..00c1e380d88 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -246,7 +246,7 @@ package Sem_Util is
-- families constrained by discriminants.
function Denotes_Variable (N : Node_Id) return Boolean;
- -- Returns True if node N denotes a single variable without parentheses.
+ -- Returns True if node N denotes a single variable without parentheses
function Depends_On_Discriminant (N : Node_Id) return Boolean;
-- Returns True if N denotes a discriminant or if N is a range, a subtype
diff --git a/gcc/ada/sequenio.ads b/gcc/ada/sequenio.ads
index 7fdf72d782f..42522fb9072 100644
--- a/gcc/ada/sequenio.ads
+++ b/gcc/ada/sequenio.ads
@@ -15,9 +15,9 @@
pragma Ada_2005;
-- Explicit setting of Ada 2005 mode is required here, since we want to with a
--- child unit (not possible in Ada 83 mode), and Text_IO is not considered to
--- be an internal unit that is automatically compiled in Ada 2005 mode (since
--- a user is allowed to redeclare Sequential_IO).
+-- child unit (not possible in Ada 83 mode), and Sequential_IO is not
+-- considered to be an internal unit that is automatically compiled in Ada
+-- 2005 mode (since a user is allowed to redeclare Sequential_IO).
with Ada.Sequential_IO;
diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb
index 957dfae2625..3936b5b311f 100644
--- a/gcc/ada/sinput.adb
+++ b/gcc/ada/sinput.adb
@@ -649,7 +649,7 @@ package body Sinput is
Chr : constant Character := Source (P);
begin
- if Chr = CR then
+ if Chr = CR then
if Source (P + 1) = LF then
P := P + 2;
else
@@ -657,7 +657,7 @@ package body Sinput is
end if;
elsif Chr = LF then
- if Source (P) = CR then
+ if Source (P + 1) = CR then
P := P + 2;
else
P := P + 1;
diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads
index 6d3144092cf..82d03e75d23 100644
--- a/gcc/ada/sinput.ads
+++ b/gcc/ada/sinput.ads
@@ -565,12 +565,12 @@ package Sinput is
procedure Skip_Line_Terminators
(P : in out Source_Ptr;
Physical : out Boolean);
- -- On entry, P points to a line terminator that has been encountered,
- -- which is one of FF,LF,VT,CR or a wide character sequence whose value is
- -- in category Separator,Line or Separator,Paragraph. The purpose of this
- -- P points just past the character that was scanned. The purpose of this
- -- routine is to distinguish physical and logical line endings. A physical
- -- line ending is one of:
+ -- On entry, P points to a line terminator that has been encountered, which
+ -- is one of FF,LF,VT,CR or a wide character sequence whose value is in
+ -- category Separator,Line or Separator,Paragraph. P points just past the
+ -- character that was scanned. The purpose of this routine is to
+ -- distinguish physical and logical line endings. A physical line ending is
+ -- one of:
--
-- CR on its own (MAC System 7)
-- LF on its own (Unix and unix-like systems)
diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb
index 7d4cdddc479..d780bc138e4 100644
--- a/gcc/ada/snames.adb
+++ b/gcc/ada/snames.adb
@@ -414,6 +414,7 @@ package body Snames is
"secondary_stack_size#" &
"section#" &
"semaphore#" &
+ "short_descriptor#" &
"simple_barriers#" &
"spec_file_name#" &
"state#" &
@@ -778,6 +779,7 @@ package body Snames is
"objects_path#" &
"objects_path_file#" &
"object_dir#" &
+ "path_syntax#" &
"pic_option#" &
"pretty_printer#" &
"prefix#" &
diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads
index c2001e68aa4..85447f7e9ce 100644
--- a/gcc/ada/snames.ads
+++ b/gcc/ada/snames.ads
@@ -394,7 +394,7 @@ package Snames is
Name_Suppress_Exception_Locations : constant Name_Id := N + 168; -- GNAT
Name_Task_Dispatching_Policy : constant Name_Id := N + 169;
Name_Universal_Data : constant Name_Id := N + 170; -- AAMP
- Name_Unsuppress : constant Name_Id := N + 171; -- GNAT
+ Name_Unsuppress : constant Name_Id := N + 171; -- Ada 05
Name_Use_VADS_Size : constant Name_Id := N + 172; -- GNAT
Name_Validity_Checks : constant Name_Id := N + 173; -- GNAT
Name_Warnings : constant Name_Id := N + 174; -- GNAT
@@ -455,6 +455,12 @@ package Snames is
Name_Inline_Always : constant Name_Id := N + 218; -- GNAT
Name_Inline_Generic : constant Name_Id := N + 219; -- GNAT
Name_Inspection_Point : constant Name_Id := N + 220;
+
+ -- Note: Interface is not in this list because its name matches -- GNAT
+ -- an Ada 2005 keyword. However it is included in the definition
+ -- of the type Attribute_Id, and the functions Get_Pragma_Id and
+ -- Is_Pragma_Id correctly recognize and process Name_Storage_Size.
+
Name_Interface_Name : constant Name_Id := N + 221; -- GNAT
Name_Interrupt_Handler : constant Name_Id := N + 222;
Name_Interrupt_Priority : constant Name_Id := N + 223;
@@ -524,7 +530,7 @@ package Snames is
Name_Task_Storage : constant Name_Id := N + 270; -- VMS
Name_Time_Slice : constant Name_Id := N + 271; -- GNAT
Name_Title : constant Name_Id := N + 272; -- GNAT
- Name_Unchecked_Union : constant Name_Id := N + 273; -- GNAT
+ Name_Unchecked_Union : constant Name_Id := N + 273; -- Ada 05
Name_Unimplemented_Unit : constant Name_Id := N + 274; -- GNAT
Name_Universal_Aliasing : constant Name_Id := N + 275; -- GNAT
Name_Unmodified : constant Name_Id := N + 276; -- GNAT
@@ -636,28 +642,29 @@ package Snames is
Name_Secondary_Stack_Size : constant Name_Id := N + 353;
Name_Section : constant Name_Id := N + 354;
Name_Semaphore : constant Name_Id := N + 355;
- Name_Simple_Barriers : constant Name_Id := N + 356;
- Name_Spec_File_Name : constant Name_Id := N + 357;
- Name_State : constant Name_Id := N + 358;
- Name_Static : constant Name_Id := N + 359;
- Name_Stack_Size : constant Name_Id := N + 360;
- Name_Subunit_File_Name : constant Name_Id := N + 361;
- Name_Task_Stack_Size_Default : constant Name_Id := N + 362;
- Name_Task_Type : constant Name_Id := N + 363;
- Name_Time_Slicing_Enabled : constant Name_Id := N + 364;
- Name_Top_Guard : constant Name_Id := N + 365;
- Name_UBA : constant Name_Id := N + 366;
- Name_UBS : constant Name_Id := N + 367;
- Name_UBSB : constant Name_Id := N + 368;
- Name_Unit_Name : constant Name_Id := N + 369;
- Name_Unknown : constant Name_Id := N + 370;
- Name_Unrestricted : constant Name_Id := N + 371;
- Name_Uppercase : constant Name_Id := N + 372;
- Name_User : constant Name_Id := N + 373;
- Name_VAX_Float : constant Name_Id := N + 374;
- Name_VMS : constant Name_Id := N + 375;
- Name_Vtable_Ptr : constant Name_Id := N + 376;
- Name_Working_Storage : constant Name_Id := N + 377;
+ Name_Short_Descriptor : constant Name_Id := N + 356;
+ Name_Simple_Barriers : constant Name_Id := N + 357;
+ Name_Spec_File_Name : constant Name_Id := N + 358;
+ Name_State : constant Name_Id := N + 359;
+ Name_Static : constant Name_Id := N + 360;
+ Name_Stack_Size : constant Name_Id := N + 361;
+ Name_Subunit_File_Name : constant Name_Id := N + 362;
+ Name_Task_Stack_Size_Default : constant Name_Id := N + 363;
+ Name_Task_Type : constant Name_Id := N + 364;
+ Name_Time_Slicing_Enabled : constant Name_Id := N + 365;
+ Name_Top_Guard : constant Name_Id := N + 366;
+ Name_UBA : constant Name_Id := N + 367;
+ Name_UBS : constant Name_Id := N + 368;
+ Name_UBSB : constant Name_Id := N + 369;
+ Name_Unit_Name : constant Name_Id := N + 370;
+ Name_Unknown : constant Name_Id := N + 371;
+ Name_Unrestricted : constant Name_Id := N + 372;
+ Name_Uppercase : constant Name_Id := N + 373;
+ Name_User : constant Name_Id := N + 374;
+ Name_VAX_Float : constant Name_Id := N + 375;
+ Name_VMS : constant Name_Id := N + 376;
+ Name_Vtable_Ptr : constant Name_Id := N + 377;
+ Name_Working_Storage : constant Name_Id := N + 378;
-- Names of recognized attributes. The entries with the comment "Ada 83"
-- are attributes that are defined in Ada 83, but not in Ada 95. These
@@ -671,175 +678,175 @@ package Snames is
-- The entries marked VMS are recognized only in OpenVMS implementations
-- of GNAT, and are treated as illegal in all other contexts.
- First_Attribute_Name : constant Name_Id := N + 378;
- Name_Abort_Signal : constant Name_Id := N + 378; -- GNAT
- Name_Access : constant Name_Id := N + 379;
- Name_Address : constant Name_Id := N + 380;
- Name_Address_Size : constant Name_Id := N + 381; -- GNAT
- Name_Aft : constant Name_Id := N + 382;
- Name_Alignment : constant Name_Id := N + 383;
- Name_Asm_Input : constant Name_Id := N + 384; -- GNAT
- Name_Asm_Output : constant Name_Id := N + 385; -- GNAT
- Name_AST_Entry : constant Name_Id := N + 386; -- VMS
- Name_Bit : constant Name_Id := N + 387; -- GNAT
- Name_Bit_Order : constant Name_Id := N + 388;
- Name_Bit_Position : constant Name_Id := N + 389; -- GNAT
- Name_Body_Version : constant Name_Id := N + 390;
- Name_Callable : constant Name_Id := N + 391;
- Name_Caller : constant Name_Id := N + 392;
- Name_Code_Address : constant Name_Id := N + 393; -- GNAT
- Name_Component_Size : constant Name_Id := N + 394;
- Name_Compose : constant Name_Id := N + 395;
- Name_Constrained : constant Name_Id := N + 396;
- Name_Count : constant Name_Id := N + 397;
- Name_Default_Bit_Order : constant Name_Id := N + 398; -- GNAT
- Name_Definite : constant Name_Id := N + 399;
- Name_Delta : constant Name_Id := N + 400;
- Name_Denorm : constant Name_Id := N + 401;
- Name_Digits : constant Name_Id := N + 402;
- Name_Elaborated : constant Name_Id := N + 403; -- GNAT
- Name_Emax : constant Name_Id := N + 404; -- Ada 83
- Name_Enabled : constant Name_Id := N + 405; -- GNAT
- Name_Enum_Rep : constant Name_Id := N + 406; -- GNAT
- Name_Enum_Val : constant Name_Id := N + 407; -- GNAT
- Name_Epsilon : constant Name_Id := N + 408; -- Ada 83
- Name_Exponent : constant Name_Id := N + 409;
- Name_External_Tag : constant Name_Id := N + 410;
- Name_Fast_Math : constant Name_Id := N + 411; -- GNAT
- Name_First : constant Name_Id := N + 412;
- Name_First_Bit : constant Name_Id := N + 413;
- Name_Fixed_Value : constant Name_Id := N + 414; -- GNAT
- Name_Fore : constant Name_Id := N + 415;
- Name_Has_Access_Values : constant Name_Id := N + 416; -- GNAT
- Name_Has_Discriminants : constant Name_Id := N + 417; -- GNAT
- Name_Has_Tagged_Values : constant Name_Id := N + 418; -- GNAT
- Name_Identity : constant Name_Id := N + 419;
- Name_Img : constant Name_Id := N + 420; -- GNAT
- Name_Integer_Value : constant Name_Id := N + 421; -- GNAT
- Name_Invalid_Value : constant Name_Id := N + 422; -- GNAT
- Name_Large : constant Name_Id := N + 423; -- Ada 83
- Name_Last : constant Name_Id := N + 424;
- Name_Last_Bit : constant Name_Id := N + 425;
- Name_Leading_Part : constant Name_Id := N + 426;
- Name_Length : constant Name_Id := N + 427;
- Name_Machine_Emax : constant Name_Id := N + 428;
- Name_Machine_Emin : constant Name_Id := N + 429;
- Name_Machine_Mantissa : constant Name_Id := N + 430;
- Name_Machine_Overflows : constant Name_Id := N + 431;
- Name_Machine_Radix : constant Name_Id := N + 432;
- Name_Machine_Rounding : constant Name_Id := N + 433; -- Ada 05
- Name_Machine_Rounds : constant Name_Id := N + 434;
- Name_Machine_Size : constant Name_Id := N + 435; -- GNAT
- Name_Mantissa : constant Name_Id := N + 436; -- Ada 83
- Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 437;
- Name_Maximum_Alignment : constant Name_Id := N + 438; -- GNAT
- Name_Mechanism_Code : constant Name_Id := N + 439; -- GNAT
- Name_Mod : constant Name_Id := N + 440; -- Ada 05
- Name_Model_Emin : constant Name_Id := N + 441;
- Name_Model_Epsilon : constant Name_Id := N + 442;
- Name_Model_Mantissa : constant Name_Id := N + 443;
- Name_Model_Small : constant Name_Id := N + 444;
- Name_Modulus : constant Name_Id := N + 445;
- Name_Null_Parameter : constant Name_Id := N + 446; -- GNAT
- Name_Object_Size : constant Name_Id := N + 447; -- GNAT
- Name_Old : constant Name_Id := N + 448; -- GNAT
- Name_Partition_ID : constant Name_Id := N + 449;
- Name_Passed_By_Reference : constant Name_Id := N + 450; -- GNAT
- Name_Pool_Address : constant Name_Id := N + 451;
- Name_Pos : constant Name_Id := N + 452;
- Name_Position : constant Name_Id := N + 453;
- Name_Priority : constant Name_Id := N + 454; -- Ada 05
- Name_Range : constant Name_Id := N + 455;
- Name_Range_Length : constant Name_Id := N + 456; -- GNAT
- Name_Result : constant Name_Id := N + 457; -- GNAT
- Name_Round : constant Name_Id := N + 458;
- Name_Safe_Emax : constant Name_Id := N + 459; -- Ada 83
- Name_Safe_First : constant Name_Id := N + 460;
- Name_Safe_Large : constant Name_Id := N + 461; -- Ada 83
- Name_Safe_Last : constant Name_Id := N + 462;
- Name_Safe_Small : constant Name_Id := N + 463; -- Ada 83
- Name_Scale : constant Name_Id := N + 464;
- Name_Scaling : constant Name_Id := N + 465;
- Name_Signed_Zeros : constant Name_Id := N + 466;
- Name_Size : constant Name_Id := N + 467;
- Name_Small : constant Name_Id := N + 468;
- Name_Storage_Size : constant Name_Id := N + 469;
- Name_Storage_Unit : constant Name_Id := N + 470; -- GNAT
- Name_Stream_Size : constant Name_Id := N + 471; -- Ada 05
- Name_Tag : constant Name_Id := N + 472;
- Name_Target_Name : constant Name_Id := N + 473; -- GNAT
- Name_Terminated : constant Name_Id := N + 474;
- Name_To_Address : constant Name_Id := N + 475; -- GNAT
- Name_Type_Class : constant Name_Id := N + 476; -- GNAT
- Name_UET_Address : constant Name_Id := N + 477; -- GNAT
- Name_Unbiased_Rounding : constant Name_Id := N + 478;
- Name_Unchecked_Access : constant Name_Id := N + 479;
- Name_Unconstrained_Array : constant Name_Id := N + 480;
- Name_Universal_Literal_String : constant Name_Id := N + 481; -- GNAT
- Name_Unrestricted_Access : constant Name_Id := N + 482; -- GNAT
- Name_VADS_Size : constant Name_Id := N + 483; -- GNAT
- Name_Val : constant Name_Id := N + 484;
- Name_Valid : constant Name_Id := N + 485;
- Name_Value_Size : constant Name_Id := N + 486; -- GNAT
- Name_Version : constant Name_Id := N + 487;
- Name_Wchar_T_Size : constant Name_Id := N + 488; -- GNAT
- Name_Wide_Wide_Width : constant Name_Id := N + 489; -- Ada 05
- Name_Wide_Width : constant Name_Id := N + 490;
- Name_Width : constant Name_Id := N + 491;
- Name_Word_Size : constant Name_Id := N + 492; -- GNAT
+ First_Attribute_Name : constant Name_Id := N + 379;
+ Name_Abort_Signal : constant Name_Id := N + 379; -- GNAT
+ Name_Access : constant Name_Id := N + 380;
+ Name_Address : constant Name_Id := N + 381;
+ Name_Address_Size : constant Name_Id := N + 382; -- GNAT
+ Name_Aft : constant Name_Id := N + 383;
+ Name_Alignment : constant Name_Id := N + 384;
+ Name_Asm_Input : constant Name_Id := N + 385; -- GNAT
+ Name_Asm_Output : constant Name_Id := N + 386; -- GNAT
+ Name_AST_Entry : constant Name_Id := N + 387; -- VMS
+ Name_Bit : constant Name_Id := N + 388; -- GNAT
+ Name_Bit_Order : constant Name_Id := N + 389;
+ Name_Bit_Position : constant Name_Id := N + 390; -- GNAT
+ Name_Body_Version : constant Name_Id := N + 391;
+ Name_Callable : constant Name_Id := N + 392;
+ Name_Caller : constant Name_Id := N + 393;
+ Name_Code_Address : constant Name_Id := N + 394; -- GNAT
+ Name_Component_Size : constant Name_Id := N + 395;
+ Name_Compose : constant Name_Id := N + 396;
+ Name_Constrained : constant Name_Id := N + 397;
+ Name_Count : constant Name_Id := N + 398;
+ Name_Default_Bit_Order : constant Name_Id := N + 399; -- GNAT
+ Name_Definite : constant Name_Id := N + 400;
+ Name_Delta : constant Name_Id := N + 401;
+ Name_Denorm : constant Name_Id := N + 402;
+ Name_Digits : constant Name_Id := N + 403;
+ Name_Elaborated : constant Name_Id := N + 404; -- GNAT
+ Name_Emax : constant Name_Id := N + 405; -- Ada 83
+ Name_Enabled : constant Name_Id := N + 406; -- GNAT
+ Name_Enum_Rep : constant Name_Id := N + 407; -- GNAT
+ Name_Enum_Val : constant Name_Id := N + 408; -- GNAT
+ Name_Epsilon : constant Name_Id := N + 409; -- Ada 83
+ Name_Exponent : constant Name_Id := N + 410;
+ Name_External_Tag : constant Name_Id := N + 411;
+ Name_Fast_Math : constant Name_Id := N + 412; -- GNAT
+ Name_First : constant Name_Id := N + 413;
+ Name_First_Bit : constant Name_Id := N + 414;
+ Name_Fixed_Value : constant Name_Id := N + 415; -- GNAT
+ Name_Fore : constant Name_Id := N + 416;
+ Name_Has_Access_Values : constant Name_Id := N + 417; -- GNAT
+ Name_Has_Discriminants : constant Name_Id := N + 418; -- GNAT
+ Name_Has_Tagged_Values : constant Name_Id := N + 419; -- GNAT
+ Name_Identity : constant Name_Id := N + 420;
+ Name_Img : constant Name_Id := N + 421; -- GNAT
+ Name_Integer_Value : constant Name_Id := N + 422; -- GNAT
+ Name_Invalid_Value : constant Name_Id := N + 423; -- GNAT
+ Name_Large : constant Name_Id := N + 424; -- Ada 83
+ Name_Last : constant Name_Id := N + 425;
+ Name_Last_Bit : constant Name_Id := N + 426;
+ Name_Leading_Part : constant Name_Id := N + 427;
+ Name_Length : constant Name_Id := N + 428;
+ Name_Machine_Emax : constant Name_Id := N + 429;
+ Name_Machine_Emin : constant Name_Id := N + 430;
+ Name_Machine_Mantissa : constant Name_Id := N + 431;
+ Name_Machine_Overflows : constant Name_Id := N + 432;
+ Name_Machine_Radix : constant Name_Id := N + 433;
+ Name_Machine_Rounding : constant Name_Id := N + 434; -- Ada 05
+ Name_Machine_Rounds : constant Name_Id := N + 435;
+ Name_Machine_Size : constant Name_Id := N + 436; -- GNAT
+ Name_Mantissa : constant Name_Id := N + 437; -- Ada 83
+ Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 438;
+ Name_Maximum_Alignment : constant Name_Id := N + 439; -- GNAT
+ Name_Mechanism_Code : constant Name_Id := N + 440; -- GNAT
+ Name_Mod : constant Name_Id := N + 441; -- Ada 05
+ Name_Model_Emin : constant Name_Id := N + 442;
+ Name_Model_Epsilon : constant Name_Id := N + 443;
+ Name_Model_Mantissa : constant Name_Id := N + 444;
+ Name_Model_Small : constant Name_Id := N + 445;
+ Name_Modulus : constant Name_Id := N + 446;
+ Name_Null_Parameter : constant Name_Id := N + 447; -- GNAT
+ Name_Object_Size : constant Name_Id := N + 448; -- GNAT
+ Name_Old : constant Name_Id := N + 449; -- GNAT
+ Name_Partition_ID : constant Name_Id := N + 450;
+ Name_Passed_By_Reference : constant Name_Id := N + 451; -- GNAT
+ Name_Pool_Address : constant Name_Id := N + 452;
+ Name_Pos : constant Name_Id := N + 453;
+ Name_Position : constant Name_Id := N + 454;
+ Name_Priority : constant Name_Id := N + 455; -- Ada 05
+ Name_Range : constant Name_Id := N + 456;
+ Name_Range_Length : constant Name_Id := N + 457; -- GNAT
+ Name_Result : constant Name_Id := N + 458; -- GNAT
+ Name_Round : constant Name_Id := N + 459;
+ Name_Safe_Emax : constant Name_Id := N + 460; -- Ada 83
+ Name_Safe_First : constant Name_Id := N + 461;
+ Name_Safe_Large : constant Name_Id := N + 462; -- Ada 83
+ Name_Safe_Last : constant Name_Id := N + 463;
+ Name_Safe_Small : constant Name_Id := N + 464; -- Ada 83
+ Name_Scale : constant Name_Id := N + 465;
+ Name_Scaling : constant Name_Id := N + 466;
+ Name_Signed_Zeros : constant Name_Id := N + 467;
+ Name_Size : constant Name_Id := N + 468;
+ Name_Small : constant Name_Id := N + 469;
+ Name_Storage_Size : constant Name_Id := N + 470;
+ Name_Storage_Unit : constant Name_Id := N + 471; -- GNAT
+ Name_Stream_Size : constant Name_Id := N + 472; -- Ada 05
+ Name_Tag : constant Name_Id := N + 473;
+ Name_Target_Name : constant Name_Id := N + 474; -- GNAT
+ Name_Terminated : constant Name_Id := N + 475;
+ Name_To_Address : constant Name_Id := N + 476; -- GNAT
+ Name_Type_Class : constant Name_Id := N + 477; -- GNAT
+ Name_UET_Address : constant Name_Id := N + 478; -- GNAT
+ Name_Unbiased_Rounding : constant Name_Id := N + 479;
+ Name_Unchecked_Access : constant Name_Id := N + 480;
+ Name_Unconstrained_Array : constant Name_Id := N + 481;
+ Name_Universal_Literal_String : constant Name_Id := N + 482; -- GNAT
+ Name_Unrestricted_Access : constant Name_Id := N + 483; -- GNAT
+ Name_VADS_Size : constant Name_Id := N + 484; -- GNAT
+ Name_Val : constant Name_Id := N + 485;
+ Name_Valid : constant Name_Id := N + 486;
+ Name_Value_Size : constant Name_Id := N + 487; -- GNAT
+ Name_Version : constant Name_Id := N + 488;
+ Name_Wchar_T_Size : constant Name_Id := N + 489; -- GNAT
+ Name_Wide_Wide_Width : constant Name_Id := N + 490; -- Ada 05
+ Name_Wide_Width : constant Name_Id := N + 491;
+ Name_Width : constant Name_Id := N + 492;
+ Name_Word_Size : constant Name_Id := N + 493; -- GNAT
-- Attributes that designate attributes returning renamable functions,
-- i.e. functions that return other than a universal value and that
-- have non-universal arguments.
- First_Renamable_Function_Attribute : constant Name_Id := N + 493;
- Name_Adjacent : constant Name_Id := N + 493;
- Name_Ceiling : constant Name_Id := N + 494;
- Name_Copy_Sign : constant Name_Id := N + 495;
- Name_Floor : constant Name_Id := N + 496;
- Name_Fraction : constant Name_Id := N + 497;
- Name_Image : constant Name_Id := N + 498;
- Name_Input : constant Name_Id := N + 499;
- Name_Machine : constant Name_Id := N + 500;
- Name_Max : constant Name_Id := N + 501;
- Name_Min : constant Name_Id := N + 502;
- Name_Model : constant Name_Id := N + 503;
- Name_Pred : constant Name_Id := N + 504;
- Name_Remainder : constant Name_Id := N + 505;
- Name_Rounding : constant Name_Id := N + 506;
- Name_Succ : constant Name_Id := N + 507;
- Name_Truncation : constant Name_Id := N + 508;
- Name_Value : constant Name_Id := N + 509;
- Name_Wide_Image : constant Name_Id := N + 510;
- Name_Wide_Wide_Image : constant Name_Id := N + 511;
- Name_Wide_Value : constant Name_Id := N + 512;
- Name_Wide_Wide_Value : constant Name_Id := N + 513;
- Last_Renamable_Function_Attribute : constant Name_Id := N + 513;
+ First_Renamable_Function_Attribute : constant Name_Id := N + 494;
+ Name_Adjacent : constant Name_Id := N + 494;
+ Name_Ceiling : constant Name_Id := N + 495;
+ Name_Copy_Sign : constant Name_Id := N + 496;
+ Name_Floor : constant Name_Id := N + 497;
+ Name_Fraction : constant Name_Id := N + 498;
+ Name_Image : constant Name_Id := N + 499;
+ Name_Input : constant Name_Id := N + 500;
+ Name_Machine : constant Name_Id := N + 501;
+ Name_Max : constant Name_Id := N + 502;
+ Name_Min : constant Name_Id := N + 503;
+ Name_Model : constant Name_Id := N + 504;
+ Name_Pred : constant Name_Id := N + 505;
+ Name_Remainder : constant Name_Id := N + 506;
+ Name_Rounding : constant Name_Id := N + 507;
+ Name_Succ : constant Name_Id := N + 508;
+ Name_Truncation : constant Name_Id := N + 509;
+ Name_Value : constant Name_Id := N + 510;
+ Name_Wide_Image : constant Name_Id := N + 511;
+ Name_Wide_Wide_Image : constant Name_Id := N + 512;
+ Name_Wide_Value : constant Name_Id := N + 513;
+ Name_Wide_Wide_Value : constant Name_Id := N + 514;
+ Last_Renamable_Function_Attribute : constant Name_Id := N + 514;
-- Attributes that designate procedures
- First_Procedure_Attribute : constant Name_Id := N + 514;
- Name_Output : constant Name_Id := N + 514;
- Name_Read : constant Name_Id := N + 515;
- Name_Write : constant Name_Id := N + 516;
- Last_Procedure_Attribute : constant Name_Id := N + 516;
+ First_Procedure_Attribute : constant Name_Id := N + 515;
+ Name_Output : constant Name_Id := N + 515;
+ Name_Read : constant Name_Id := N + 516;
+ Name_Write : constant Name_Id := N + 517;
+ Last_Procedure_Attribute : constant Name_Id := N + 517;
-- Remaining attributes are ones that return entities
- First_Entity_Attribute_Name : constant Name_Id := N + 517;
- Name_Elab_Body : constant Name_Id := N + 517; -- GNAT
- Name_Elab_Spec : constant Name_Id := N + 518; -- GNAT
- Name_Storage_Pool : constant Name_Id := N + 519;
+ First_Entity_Attribute_Name : constant Name_Id := N + 518;
+ Name_Elab_Body : constant Name_Id := N + 518; -- GNAT
+ Name_Elab_Spec : constant Name_Id := N + 519; -- GNAT
+ Name_Storage_Pool : constant Name_Id := N + 520;
-- These attributes are the ones that return types
- First_Type_Attribute_Name : constant Name_Id := N + 520;
- Name_Base : constant Name_Id := N + 520;
- Name_Class : constant Name_Id := N + 521;
- Name_Stub_Type : constant Name_Id := N + 522;
- Last_Type_Attribute_Name : constant Name_Id := N + 522;
- Last_Entity_Attribute_Name : constant Name_Id := N + 522;
- Last_Attribute_Name : constant Name_Id := N + 522;
+ First_Type_Attribute_Name : constant Name_Id := N + 521;
+ Name_Base : constant Name_Id := N + 521;
+ Name_Class : constant Name_Id := N + 522;
+ Name_Stub_Type : constant Name_Id := N + 523;
+ Last_Type_Attribute_Name : constant Name_Id := N + 523;
+ Last_Entity_Attribute_Name : constant Name_Id := N + 523;
+ Last_Attribute_Name : constant Name_Id := N + 523;
-- Names of recognized locking policy identifiers
@@ -847,10 +854,10 @@ package Snames is
-- name (e.g. C for Ceiling_Locking). If new policy names are added,
-- the first character must be distinct.
- First_Locking_Policy_Name : constant Name_Id := N + 523;
- Name_Ceiling_Locking : constant Name_Id := N + 523;
- Name_Inheritance_Locking : constant Name_Id := N + 524;
- Last_Locking_Policy_Name : constant Name_Id := N + 524;
+ First_Locking_Policy_Name : constant Name_Id := N + 524;
+ Name_Ceiling_Locking : constant Name_Id := N + 524;
+ Name_Inheritance_Locking : constant Name_Id := N + 525;
+ Last_Locking_Policy_Name : constant Name_Id := N + 525;
-- Names of recognized queuing policy identifiers
@@ -858,10 +865,10 @@ package Snames is
-- name (e.g. F for FIFO_Queuing). If new policy names are added,
-- the first character must be distinct.
- First_Queuing_Policy_Name : constant Name_Id := N + 525;
- Name_FIFO_Queuing : constant Name_Id := N + 525;
- Name_Priority_Queuing : constant Name_Id := N + 526;
- Last_Queuing_Policy_Name : constant Name_Id := N + 526;
+ First_Queuing_Policy_Name : constant Name_Id := N + 526;
+ Name_FIFO_Queuing : constant Name_Id := N + 526;
+ Name_Priority_Queuing : constant Name_Id := N + 527;
+ Last_Queuing_Policy_Name : constant Name_Id := N + 527;
-- Names of recognized task dispatching policy identifiers
@@ -869,283 +876,284 @@ package Snames is
-- name (e.g. F for FIFO_Within_Priorities). If new policy names
-- are added, the first character must be distinct.
- First_Task_Dispatching_Policy_Name : constant Name_Id := N + 527;
- Name_EDF_Across_Priorities : constant Name_Id := N + 527;
- Name_FIFO_Within_Priorities : constant Name_Id := N + 528;
- Name_Non_Preemptive_Within_Priorities : constant Name_Id := N + 529;
- Name_Round_Robin_Within_Priorities : constant Name_Id := N + 530;
- Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 530;
+ First_Task_Dispatching_Policy_Name : constant Name_Id := N + 528;
+ Name_EDF_Across_Priorities : constant Name_Id := N + 528;
+ Name_FIFO_Within_Priorities : constant Name_Id := N + 529;
+ Name_Non_Preemptive_Within_Priorities : constant Name_Id := N + 530;
+ Name_Round_Robin_Within_Priorities : constant Name_Id := N + 531;
+ Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 531;
-- Names of recognized checks for pragma Suppress
- First_Check_Name : constant Name_Id := N + 531;
- Name_Access_Check : constant Name_Id := N + 531;
- Name_Accessibility_Check : constant Name_Id := N + 532;
- Name_Alignment_Check : constant Name_Id := N + 533; -- GNAT
- Name_Discriminant_Check : constant Name_Id := N + 534;
- Name_Division_Check : constant Name_Id := N + 535;
- Name_Elaboration_Check : constant Name_Id := N + 536;
- Name_Index_Check : constant Name_Id := N + 537;
- Name_Length_Check : constant Name_Id := N + 538;
- Name_Overflow_Check : constant Name_Id := N + 539;
- Name_Range_Check : constant Name_Id := N + 540;
- Name_Storage_Check : constant Name_Id := N + 541;
- Name_Tag_Check : constant Name_Id := N + 542;
- Name_Validity_Check : constant Name_Id := N + 543; -- GNAT
- Name_All_Checks : constant Name_Id := N + 544;
- Last_Check_Name : constant Name_Id := N + 544;
+ First_Check_Name : constant Name_Id := N + 532;
+ Name_Access_Check : constant Name_Id := N + 532;
+ Name_Accessibility_Check : constant Name_Id := N + 533;
+ Name_Alignment_Check : constant Name_Id := N + 534; -- GNAT
+ Name_Discriminant_Check : constant Name_Id := N + 535;
+ Name_Division_Check : constant Name_Id := N + 536;
+ Name_Elaboration_Check : constant Name_Id := N + 537;
+ Name_Index_Check : constant Name_Id := N + 538;
+ Name_Length_Check : constant Name_Id := N + 539;
+ Name_Overflow_Check : constant Name_Id := N + 540;
+ Name_Range_Check : constant Name_Id := N + 541;
+ Name_Storage_Check : constant Name_Id := N + 542;
+ Name_Tag_Check : constant Name_Id := N + 543;
+ Name_Validity_Check : constant Name_Id := N + 544; -- GNAT
+ Name_All_Checks : constant Name_Id := N + 545;
+ Last_Check_Name : constant Name_Id := N + 545;
-- Names corresponding to reserved keywords, excluding those already
-- declared in the attribute list (Access, Delta, Digits, Mod, Range).
- Name_Abort : constant Name_Id := N + 545;
- Name_Abs : constant Name_Id := N + 546;
- Name_Accept : constant Name_Id := N + 547;
- Name_And : constant Name_Id := N + 548;
- Name_All : constant Name_Id := N + 549;
- Name_Array : constant Name_Id := N + 550;
- Name_At : constant Name_Id := N + 551;
- Name_Begin : constant Name_Id := N + 552;
- Name_Body : constant Name_Id := N + 553;
- Name_Case : constant Name_Id := N + 554;
- Name_Constant : constant Name_Id := N + 555;
- Name_Declare : constant Name_Id := N + 556;
- Name_Delay : constant Name_Id := N + 557;
- Name_Do : constant Name_Id := N + 558;
- Name_Else : constant Name_Id := N + 559;
- Name_Elsif : constant Name_Id := N + 560;
- Name_End : constant Name_Id := N + 561;
- Name_Entry : constant Name_Id := N + 562;
- Name_Exception : constant Name_Id := N + 563;
- Name_Exit : constant Name_Id := N + 564;
- Name_For : constant Name_Id := N + 565;
- Name_Function : constant Name_Id := N + 566;
- Name_Generic : constant Name_Id := N + 567;
- Name_Goto : constant Name_Id := N + 568;
- Name_If : constant Name_Id := N + 569;
- Name_In : constant Name_Id := N + 570;
- Name_Is : constant Name_Id := N + 571;
- Name_Limited : constant Name_Id := N + 572;
- Name_Loop : constant Name_Id := N + 573;
- Name_New : constant Name_Id := N + 574;
- Name_Not : constant Name_Id := N + 575;
- Name_Null : constant Name_Id := N + 576;
- Name_Of : constant Name_Id := N + 577;
- Name_Or : constant Name_Id := N + 578;
- Name_Others : constant Name_Id := N + 579;
- Name_Out : constant Name_Id := N + 580;
- Name_Package : constant Name_Id := N + 581;
- Name_Pragma : constant Name_Id := N + 582;
- Name_Private : constant Name_Id := N + 583;
- Name_Procedure : constant Name_Id := N + 584;
- Name_Raise : constant Name_Id := N + 585;
- Name_Record : constant Name_Id := N + 586;
- Name_Rem : constant Name_Id := N + 587;
- Name_Renames : constant Name_Id := N + 588;
- Name_Return : constant Name_Id := N + 589;
- Name_Reverse : constant Name_Id := N + 590;
- Name_Select : constant Name_Id := N + 591;
- Name_Separate : constant Name_Id := N + 592;
- Name_Subtype : constant Name_Id := N + 593;
- Name_Task : constant Name_Id := N + 594;
- Name_Terminate : constant Name_Id := N + 595;
- Name_Then : constant Name_Id := N + 596;
- Name_Type : constant Name_Id := N + 597;
- Name_Use : constant Name_Id := N + 598;
- Name_When : constant Name_Id := N + 599;
- Name_While : constant Name_Id := N + 600;
- Name_With : constant Name_Id := N + 601;
- Name_Xor : constant Name_Id := N + 602;
+ Name_Abort : constant Name_Id := N + 546;
+ Name_Abs : constant Name_Id := N + 547;
+ Name_Accept : constant Name_Id := N + 548;
+ Name_And : constant Name_Id := N + 549;
+ Name_All : constant Name_Id := N + 550;
+ Name_Array : constant Name_Id := N + 551;
+ Name_At : constant Name_Id := N + 552;
+ Name_Begin : constant Name_Id := N + 553;
+ Name_Body : constant Name_Id := N + 554;
+ Name_Case : constant Name_Id := N + 555;
+ Name_Constant : constant Name_Id := N + 556;
+ Name_Declare : constant Name_Id := N + 557;
+ Name_Delay : constant Name_Id := N + 558;
+ Name_Do : constant Name_Id := N + 559;
+ Name_Else : constant Name_Id := N + 560;
+ Name_Elsif : constant Name_Id := N + 561;
+ Name_End : constant Name_Id := N + 562;
+ Name_Entry : constant Name_Id := N + 563;
+ Name_Exception : constant Name_Id := N + 564;
+ Name_Exit : constant Name_Id := N + 565;
+ Name_For : constant Name_Id := N + 566;
+ Name_Function : constant Name_Id := N + 567;
+ Name_Generic : constant Name_Id := N + 568;
+ Name_Goto : constant Name_Id := N + 569;
+ Name_If : constant Name_Id := N + 570;
+ Name_In : constant Name_Id := N + 571;
+ Name_Is : constant Name_Id := N + 572;
+ Name_Limited : constant Name_Id := N + 573;
+ Name_Loop : constant Name_Id := N + 574;
+ Name_New : constant Name_Id := N + 575;
+ Name_Not : constant Name_Id := N + 576;
+ Name_Null : constant Name_Id := N + 577;
+ Name_Of : constant Name_Id := N + 578;
+ Name_Or : constant Name_Id := N + 579;
+ Name_Others : constant Name_Id := N + 580;
+ Name_Out : constant Name_Id := N + 581;
+ Name_Package : constant Name_Id := N + 582;
+ Name_Pragma : constant Name_Id := N + 583;
+ Name_Private : constant Name_Id := N + 584;
+ Name_Procedure : constant Name_Id := N + 585;
+ Name_Raise : constant Name_Id := N + 586;
+ Name_Record : constant Name_Id := N + 587;
+ Name_Rem : constant Name_Id := N + 588;
+ Name_Renames : constant Name_Id := N + 589;
+ Name_Return : constant Name_Id := N + 590;
+ Name_Reverse : constant Name_Id := N + 591;
+ Name_Select : constant Name_Id := N + 592;
+ Name_Separate : constant Name_Id := N + 593;
+ Name_Subtype : constant Name_Id := N + 594;
+ Name_Task : constant Name_Id := N + 595;
+ Name_Terminate : constant Name_Id := N + 596;
+ Name_Then : constant Name_Id := N + 597;
+ Name_Type : constant Name_Id := N + 598;
+ Name_Use : constant Name_Id := N + 599;
+ Name_When : constant Name_Id := N + 600;
+ Name_While : constant Name_Id := N + 601;
+ Name_With : constant Name_Id := N + 602;
+ Name_Xor : constant Name_Id := N + 603;
-- Names of intrinsic subprograms
-- Note: Asm is missing from this list, since Asm is a legitimate
-- convention name. So is To_Address, which is a GNAT attribute.
- First_Intrinsic_Name : constant Name_Id := N + 603;
- Name_Divide : constant Name_Id := N + 603;
- Name_Enclosing_Entity : constant Name_Id := N + 604;
- Name_Exception_Information : constant Name_Id := N + 605;
- Name_Exception_Message : constant Name_Id := N + 606;
- Name_Exception_Name : constant Name_Id := N + 607;
- Name_File : constant Name_Id := N + 608;
- Name_Generic_Dispatching_Constructor : constant Name_Id := N + 609;
- Name_Import_Address : constant Name_Id := N + 610;
- Name_Import_Largest_Value : constant Name_Id := N + 611;
- Name_Import_Value : constant Name_Id := N + 612;
- Name_Is_Negative : constant Name_Id := N + 613;
- Name_Line : constant Name_Id := N + 614;
- Name_Rotate_Left : constant Name_Id := N + 615;
- Name_Rotate_Right : constant Name_Id := N + 616;
- Name_Shift_Left : constant Name_Id := N + 617;
- Name_Shift_Right : constant Name_Id := N + 618;
- Name_Shift_Right_Arithmetic : constant Name_Id := N + 619;
- Name_Source_Location : constant Name_Id := N + 620;
- Name_Unchecked_Conversion : constant Name_Id := N + 621;
- Name_Unchecked_Deallocation : constant Name_Id := N + 622;
- Name_To_Pointer : constant Name_Id := N + 623;
- Last_Intrinsic_Name : constant Name_Id := N + 623;
+ First_Intrinsic_Name : constant Name_Id := N + 604;
+ Name_Divide : constant Name_Id := N + 604;
+ Name_Enclosing_Entity : constant Name_Id := N + 605;
+ Name_Exception_Information : constant Name_Id := N + 606;
+ Name_Exception_Message : constant Name_Id := N + 607;
+ Name_Exception_Name : constant Name_Id := N + 608;
+ Name_File : constant Name_Id := N + 609;
+ Name_Generic_Dispatching_Constructor : constant Name_Id := N + 610;
+ Name_Import_Address : constant Name_Id := N + 611;
+ Name_Import_Largest_Value : constant Name_Id := N + 612;
+ Name_Import_Value : constant Name_Id := N + 613;
+ Name_Is_Negative : constant Name_Id := N + 614;
+ Name_Line : constant Name_Id := N + 615;
+ Name_Rotate_Left : constant Name_Id := N + 616;
+ Name_Rotate_Right : constant Name_Id := N + 617;
+ Name_Shift_Left : constant Name_Id := N + 618;
+ Name_Shift_Right : constant Name_Id := N + 619;
+ Name_Shift_Right_Arithmetic : constant Name_Id := N + 620;
+ Name_Source_Location : constant Name_Id := N + 621;
+ Name_Unchecked_Conversion : constant Name_Id := N + 622;
+ Name_Unchecked_Deallocation : constant Name_Id := N + 623;
+ Name_To_Pointer : constant Name_Id := N + 624;
+ Last_Intrinsic_Name : constant Name_Id := N + 624;
-- Names used in processing intrinsic calls
- Name_Free : constant Name_Id := N + 624;
+ Name_Free : constant Name_Id := N + 625;
-- Reserved words used only in Ada 95
- First_95_Reserved_Word : constant Name_Id := N + 625;
- Name_Abstract : constant Name_Id := N + 625;
- Name_Aliased : constant Name_Id := N + 626;
- Name_Protected : constant Name_Id := N + 627;
- Name_Until : constant Name_Id := N + 628;
- Name_Requeue : constant Name_Id := N + 629;
- Name_Tagged : constant Name_Id := N + 630;
- Last_95_Reserved_Word : constant Name_Id := N + 630;
+ First_95_Reserved_Word : constant Name_Id := N + 626;
+ Name_Abstract : constant Name_Id := N + 626;
+ Name_Aliased : constant Name_Id := N + 627;
+ Name_Protected : constant Name_Id := N + 628;
+ Name_Until : constant Name_Id := N + 629;
+ Name_Requeue : constant Name_Id := N + 630;
+ Name_Tagged : constant Name_Id := N + 631;
+ Last_95_Reserved_Word : constant Name_Id := N + 631;
subtype Ada_95_Reserved_Words is
Name_Id range First_95_Reserved_Word .. Last_95_Reserved_Word;
-- Miscellaneous names used in semantic checking
- Name_Raise_Exception : constant Name_Id := N + 631;
+ Name_Raise_Exception : constant Name_Id := N + 632;
-- Additional reserved words and identifiers used in GNAT Project Files
-- Note that Name_External is already previously declared
- Name_Ada_Roots : constant Name_Id := N + 632;
- Name_Aggregate : constant Name_Id := N + 633;
- Name_Archive_Builder : constant Name_Id := N + 634;
- Name_Archive_Builder_Append_Option : constant Name_Id := N + 635;
- Name_Archive_Indexer : constant Name_Id := N + 636;
- Name_Archive_Suffix : constant Name_Id := N + 637;
- Name_Binder : constant Name_Id := N + 638;
- Name_Binder_Prefix : constant Name_Id := N + 639;
- Name_Body_Suffix : constant Name_Id := N + 640;
- Name_Builder : constant Name_Id := N + 641;
- Name_Builder_Switches : constant Name_Id := N + 642;
- Name_Compiler : constant Name_Id := N + 643;
- Name_Compiler_Kind : constant Name_Id := N + 644;
- Name_Config_Body_File_Name : constant Name_Id := N + 645;
- Name_Config_Body_File_Name_Pattern : constant Name_Id := N + 646;
- Name_Config_File_Switches : constant Name_Id := N + 647;
- Name_Config_File_Unique : constant Name_Id := N + 648;
- Name_Config_Spec_File_Name : constant Name_Id := N + 649;
- Name_Config_Spec_File_Name_Pattern : constant Name_Id := N + 650;
- Name_Configuration : constant Name_Id := N + 651;
- Name_Cross_Reference : constant Name_Id := N + 652;
- Name_Default_Language : constant Name_Id := N + 653;
- Name_Default_Switches : constant Name_Id := N + 654;
- Name_Dependency_Driver : constant Name_Id := N + 655;
- Name_Dependency_File_Kind : constant Name_Id := N + 656;
- Name_Dependency_Switches : constant Name_Id := N + 657;
- Name_Driver : constant Name_Id := N + 658;
- Name_Excluded_Source_Dirs : constant Name_Id := N + 659;
- Name_Excluded_Source_Files : constant Name_Id := N + 660;
- Name_Excluded_Source_List_File : constant Name_Id := N + 661;
- Name_Exec_Dir : constant Name_Id := N + 662;
- Name_Executable : constant Name_Id := N + 663;
- Name_Executable_Suffix : constant Name_Id := N + 664;
- Name_Extends : constant Name_Id := N + 665;
- Name_Externally_Built : constant Name_Id := N + 666;
- Name_Finder : constant Name_Id := N + 667;
- Name_Global_Configuration_Pragmas : constant Name_Id := N + 668;
- Name_Global_Config_File : constant Name_Id := N + 669;
- Name_Gnatls : constant Name_Id := N + 670;
- Name_Gnatstub : constant Name_Id := N + 671;
- Name_Implementation : constant Name_Id := N + 672;
- Name_Implementation_Exceptions : constant Name_Id := N + 673;
- Name_Implementation_Suffix : constant Name_Id := N + 674;
- Name_Include_Switches : constant Name_Id := N + 675;
- Name_Include_Path : constant Name_Id := N + 676;
- Name_Include_Path_File : constant Name_Id := N + 677;
- Name_Inherit_Source_Path : constant Name_Id := N + 678;
- Name_Language_Kind : constant Name_Id := N + 679;
- Name_Language_Processing : constant Name_Id := N + 680;
- Name_Languages : constant Name_Id := N + 681;
- Name_Library : constant Name_Id := N + 682;
- Name_Library_Ali_Dir : constant Name_Id := N + 683;
- Name_Library_Auto_Init : constant Name_Id := N + 684;
- Name_Library_Auto_Init_Supported : constant Name_Id := N + 685;
- Name_Library_Builder : constant Name_Id := N + 686;
- Name_Library_Dir : constant Name_Id := N + 687;
- Name_Library_GCC : constant Name_Id := N + 688;
- Name_Library_Interface : constant Name_Id := N + 689;
- Name_Library_Kind : constant Name_Id := N + 690;
- Name_Library_Name : constant Name_Id := N + 691;
- Name_Library_Major_Minor_Id_Supported : constant Name_Id := N + 692;
- Name_Library_Options : constant Name_Id := N + 693;
- Name_Library_Partial_Linker : constant Name_Id := N + 694;
- Name_Library_Reference_Symbol_File : constant Name_Id := N + 695;
- Name_Library_Src_Dir : constant Name_Id := N + 696;
- Name_Library_Support : constant Name_Id := N + 697;
- Name_Library_Symbol_File : constant Name_Id := N + 698;
- Name_Library_Symbol_Policy : constant Name_Id := N + 699;
- Name_Library_Version : constant Name_Id := N + 700;
- Name_Library_Version_Switches : constant Name_Id := N + 701;
- Name_Linker : constant Name_Id := N + 702;
- Name_Linker_Executable_Option : constant Name_Id := N + 703;
- Name_Linker_Lib_Dir_Option : constant Name_Id := N + 704;
- Name_Linker_Lib_Name_Option : constant Name_Id := N + 705;
- Name_Local_Config_File : constant Name_Id := N + 706;
- Name_Local_Configuration_Pragmas : constant Name_Id := N + 707;
- Name_Locally_Removed_Files : constant Name_Id := N + 708;
- Name_Map_File_Option : constant Name_Id := N + 709;
- Name_Mapping_File_Switches : constant Name_Id := N + 710;
- Name_Mapping_Spec_Suffix : constant Name_Id := N + 711;
- Name_Mapping_Body_Suffix : constant Name_Id := N + 712;
- Name_Metrics : constant Name_Id := N + 713;
- Name_Naming : constant Name_Id := N + 714;
- Name_Object_Generated : constant Name_Id := N + 715;
- Name_Objects_Linked : constant Name_Id := N + 716;
- Name_Objects_Path : constant Name_Id := N + 717;
- Name_Objects_Path_File : constant Name_Id := N + 718;
- Name_Object_Dir : constant Name_Id := N + 719;
- Name_Pic_Option : constant Name_Id := N + 720;
- Name_Pretty_Printer : constant Name_Id := N + 721;
- Name_Prefix : constant Name_Id := N + 722;
- Name_Project : constant Name_Id := N + 723;
- Name_Roots : constant Name_Id := N + 724;
- Name_Required_Switches : constant Name_Id := N + 725;
- Name_Run_Path_Option : constant Name_Id := N + 726;
- Name_Runtime_Project : constant Name_Id := N + 727;
- Name_Shared_Library_Minimum_Switches : constant Name_Id := N + 728;
- Name_Shared_Library_Prefix : constant Name_Id := N + 729;
- Name_Shared_Library_Suffix : constant Name_Id := N + 730;
- Name_Separate_Suffix : constant Name_Id := N + 731;
- Name_Source_Dirs : constant Name_Id := N + 732;
- Name_Source_Files : constant Name_Id := N + 733;
- Name_Source_List_File : constant Name_Id := N + 734;
- Name_Spec : constant Name_Id := N + 735;
- Name_Spec_Suffix : constant Name_Id := N + 736;
- Name_Specification : constant Name_Id := N + 737;
- Name_Specification_Exceptions : constant Name_Id := N + 738;
- Name_Specification_Suffix : constant Name_Id := N + 739;
- Name_Stack : constant Name_Id := N + 740;
- Name_Switches : constant Name_Id := N + 741;
- Name_Symbolic_Link_Supported : constant Name_Id := N + 742;
- Name_Sync : constant Name_Id := N + 743;
- Name_Synchronize : constant Name_Id := N + 744;
- Name_Toolchain_Description : constant Name_Id := N + 745;
- Name_Toolchain_Version : constant Name_Id := N + 746;
- Name_Runtime_Library_Dir : constant Name_Id := N + 747;
+ Name_Ada_Roots : constant Name_Id := N + 633;
+ Name_Aggregate : constant Name_Id := N + 634;
+ Name_Archive_Builder : constant Name_Id := N + 635;
+ Name_Archive_Builder_Append_Option : constant Name_Id := N + 636;
+ Name_Archive_Indexer : constant Name_Id := N + 637;
+ Name_Archive_Suffix : constant Name_Id := N + 638;
+ Name_Binder : constant Name_Id := N + 639;
+ Name_Binder_Prefix : constant Name_Id := N + 640;
+ Name_Body_Suffix : constant Name_Id := N + 641;
+ Name_Builder : constant Name_Id := N + 642;
+ Name_Builder_Switches : constant Name_Id := N + 643;
+ Name_Compiler : constant Name_Id := N + 644;
+ Name_Compiler_Kind : constant Name_Id := N + 645;
+ Name_Config_Body_File_Name : constant Name_Id := N + 646;
+ Name_Config_Body_File_Name_Pattern : constant Name_Id := N + 647;
+ Name_Config_File_Switches : constant Name_Id := N + 648;
+ Name_Config_File_Unique : constant Name_Id := N + 649;
+ Name_Config_Spec_File_Name : constant Name_Id := N + 650;
+ Name_Config_Spec_File_Name_Pattern : constant Name_Id := N + 651;
+ Name_Configuration : constant Name_Id := N + 652;
+ Name_Cross_Reference : constant Name_Id := N + 653;
+ Name_Default_Language : constant Name_Id := N + 654;
+ Name_Default_Switches : constant Name_Id := N + 655;
+ Name_Dependency_Driver : constant Name_Id := N + 656;
+ Name_Dependency_File_Kind : constant Name_Id := N + 657;
+ Name_Dependency_Switches : constant Name_Id := N + 658;
+ Name_Driver : constant Name_Id := N + 659;
+ Name_Excluded_Source_Dirs : constant Name_Id := N + 660;
+ Name_Excluded_Source_Files : constant Name_Id := N + 661;
+ Name_Excluded_Source_List_File : constant Name_Id := N + 662;
+ Name_Exec_Dir : constant Name_Id := N + 663;
+ Name_Executable : constant Name_Id := N + 664;
+ Name_Executable_Suffix : constant Name_Id := N + 665;
+ Name_Extends : constant Name_Id := N + 666;
+ Name_Externally_Built : constant Name_Id := N + 667;
+ Name_Finder : constant Name_Id := N + 668;
+ Name_Global_Configuration_Pragmas : constant Name_Id := N + 669;
+ Name_Global_Config_File : constant Name_Id := N + 670;
+ Name_Gnatls : constant Name_Id := N + 671;
+ Name_Gnatstub : constant Name_Id := N + 672;
+ Name_Implementation : constant Name_Id := N + 673;
+ Name_Implementation_Exceptions : constant Name_Id := N + 674;
+ Name_Implementation_Suffix : constant Name_Id := N + 675;
+ Name_Include_Switches : constant Name_Id := N + 676;
+ Name_Include_Path : constant Name_Id := N + 677;
+ Name_Include_Path_File : constant Name_Id := N + 678;
+ Name_Inherit_Source_Path : constant Name_Id := N + 679;
+ Name_Language_Kind : constant Name_Id := N + 680;
+ Name_Language_Processing : constant Name_Id := N + 681;
+ Name_Languages : constant Name_Id := N + 682;
+ Name_Library : constant Name_Id := N + 683;
+ Name_Library_Ali_Dir : constant Name_Id := N + 684;
+ Name_Library_Auto_Init : constant Name_Id := N + 685;
+ Name_Library_Auto_Init_Supported : constant Name_Id := N + 686;
+ Name_Library_Builder : constant Name_Id := N + 687;
+ Name_Library_Dir : constant Name_Id := N + 688;
+ Name_Library_GCC : constant Name_Id := N + 689;
+ Name_Library_Interface : constant Name_Id := N + 690;
+ Name_Library_Kind : constant Name_Id := N + 691;
+ Name_Library_Name : constant Name_Id := N + 692;
+ Name_Library_Major_Minor_Id_Supported : constant Name_Id := N + 693;
+ Name_Library_Options : constant Name_Id := N + 694;
+ Name_Library_Partial_Linker : constant Name_Id := N + 695;
+ Name_Library_Reference_Symbol_File : constant Name_Id := N + 696;
+ Name_Library_Src_Dir : constant Name_Id := N + 697;
+ Name_Library_Support : constant Name_Id := N + 698;
+ Name_Library_Symbol_File : constant Name_Id := N + 699;
+ Name_Library_Symbol_Policy : constant Name_Id := N + 700;
+ Name_Library_Version : constant Name_Id := N + 701;
+ Name_Library_Version_Switches : constant Name_Id := N + 702;
+ Name_Linker : constant Name_Id := N + 703;
+ Name_Linker_Executable_Option : constant Name_Id := N + 704;
+ Name_Linker_Lib_Dir_Option : constant Name_Id := N + 705;
+ Name_Linker_Lib_Name_Option : constant Name_Id := N + 706;
+ Name_Local_Config_File : constant Name_Id := N + 707;
+ Name_Local_Configuration_Pragmas : constant Name_Id := N + 708;
+ Name_Locally_Removed_Files : constant Name_Id := N + 709;
+ Name_Map_File_Option : constant Name_Id := N + 710;
+ Name_Mapping_File_Switches : constant Name_Id := N + 711;
+ Name_Mapping_Spec_Suffix : constant Name_Id := N + 712;
+ Name_Mapping_Body_Suffix : constant Name_Id := N + 713;
+ Name_Metrics : constant Name_Id := N + 714;
+ Name_Naming : constant Name_Id := N + 715;
+ Name_Object_Generated : constant Name_Id := N + 716;
+ Name_Objects_Linked : constant Name_Id := N + 717;
+ Name_Objects_Path : constant Name_Id := N + 718;
+ Name_Objects_Path_File : constant Name_Id := N + 719;
+ Name_Object_Dir : constant Name_Id := N + 720;
+ Name_Path_Syntax : constant Name_Id := N + 721;
+ Name_Pic_Option : constant Name_Id := N + 722;
+ Name_Pretty_Printer : constant Name_Id := N + 723;
+ Name_Prefix : constant Name_Id := N + 724;
+ Name_Project : constant Name_Id := N + 725;
+ Name_Roots : constant Name_Id := N + 726;
+ Name_Required_Switches : constant Name_Id := N + 727;
+ Name_Run_Path_Option : constant Name_Id := N + 728;
+ Name_Runtime_Project : constant Name_Id := N + 729;
+ Name_Shared_Library_Minimum_Switches : constant Name_Id := N + 730;
+ Name_Shared_Library_Prefix : constant Name_Id := N + 731;
+ Name_Shared_Library_Suffix : constant Name_Id := N + 732;
+ Name_Separate_Suffix : constant Name_Id := N + 733;
+ Name_Source_Dirs : constant Name_Id := N + 734;
+ Name_Source_Files : constant Name_Id := N + 735;
+ Name_Source_List_File : constant Name_Id := N + 736;
+ Name_Spec : constant Name_Id := N + 737;
+ Name_Spec_Suffix : constant Name_Id := N + 738;
+ Name_Specification : constant Name_Id := N + 739;
+ Name_Specification_Exceptions : constant Name_Id := N + 740;
+ Name_Specification_Suffix : constant Name_Id := N + 741;
+ Name_Stack : constant Name_Id := N + 742;
+ Name_Switches : constant Name_Id := N + 743;
+ Name_Symbolic_Link_Supported : constant Name_Id := N + 744;
+ Name_Sync : constant Name_Id := N + 745;
+ Name_Synchronize : constant Name_Id := N + 746;
+ Name_Toolchain_Description : constant Name_Id := N + 747;
+ Name_Toolchain_Version : constant Name_Id := N + 748;
+ Name_Runtime_Library_Dir : constant Name_Id := N + 749;
-- Other miscellaneous names used in front end
- Name_Unaligned_Valid : constant Name_Id := N + 748;
+ Name_Unaligned_Valid : constant Name_Id := N + 750;
-- Ada 2005 reserved words
- First_2005_Reserved_Word : constant Name_Id := N + 749;
- Name_Interface : constant Name_Id := N + 749;
- Name_Overriding : constant Name_Id := N + 750;
- Name_Synchronized : constant Name_Id := N + 751;
- Last_2005_Reserved_Word : constant Name_Id := N + 751;
+ First_2005_Reserved_Word : constant Name_Id := N + 751;
+ Name_Interface : constant Name_Id := N + 751;
+ Name_Overriding : constant Name_Id := N + 752;
+ Name_Synchronized : constant Name_Id := N + 753;
+ Last_2005_Reserved_Word : constant Name_Id := N + 753;
subtype Ada_2005_Reserved_Words is
Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word;
-- Mark last defined name for consistency check in Snames body
- Last_Predefined_Name : constant Name_Id := N + 751;
+ Last_Predefined_Name : constant Name_Id := N + 753;
---------------------------------------
-- Subtypes Defining Name Categories --
diff --git a/gcc/ada/snames.h b/gcc/ada/snames.h
index 80ed0392a30..5724e17fc34 100644
--- a/gcc/ada/snames.h
+++ b/gcc/ada/snames.h
@@ -254,8 +254,8 @@ extern unsigned char Get_Pragma_Id (int);
#define Pragma_No_Strict_Aliasing 30
#define Pragma_Normalize_Scalars 31
#define Pragma_Optimize_Alignment 32
-#define Pragma_Polling 33
-#define Pragma_Persistent_BSS 34
+#define Pragma_Persistent_BSS 33
+#define Pragma_Polling 34
#define Pragma_Priority_Specific_Dispatching 35
#define Pragma_Profile 36
#define Pragma_Profile_Warnings 37
diff --git a/gcc/ada/tbuild.ads b/gcc/ada/tbuild.ads
index 14028630021..cca0d200bf5 100644
--- a/gcc/ada/tbuild.ads
+++ b/gcc/ada/tbuild.ads
@@ -214,7 +214,7 @@ package Tbuild is
-- Suffix is also a single upper case letter other than O,Q,U,W,X and is a
-- required parameter (T is permitted). The constructed name is stored
- -- using Find_Name so that it can be located using a subsequent Find_Name
+ -- using Name_Find so that it can be located using a subsequent Name_Find
-- operation (i.e. it is properly hashed into the names table). The upper
-- case letter given as the Suffix argument ensures that the name does
-- not clash with any Ada identifier name. These generated names are
@@ -228,7 +228,7 @@ package Tbuild is
-- Suffix & Suffix_Index'Image
-- where Suffix is a single upper case letter other than O,Q,U,W,X and is
-- a required parameter (T is permitted). The constructed name is stored
- -- using Find_Name so that it can be located using a subsequent Find_Name
+ -- using Name_Find so that it can be located using a subsequent Name_Find
-- operation (i.e. it is properly hashed into the names table). The upper
-- case letter given as the Suffix argument ensures that the name does
-- not clash with any Ada identifier name. These generated names are
diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb
index a25cfae44fa..5fb53ae339e 100644
--- a/gcc/ada/treepr.adb
+++ b/gcc/ada/treepr.adb
@@ -531,17 +531,44 @@ package body Treepr is
begin
case M is
- when Default_Mechanism => Write_Str ("Default");
- when By_Copy => Write_Str ("By_Copy");
- when By_Reference => Write_Str ("By_Reference");
- when By_Descriptor => Write_Str ("By_Descriptor");
- when By_Descriptor_UBS => Write_Str ("By_Descriptor_UBS");
- when By_Descriptor_UBSB => Write_Str ("By_Descriptor_UBSB");
- when By_Descriptor_UBA => Write_Str ("By_Descriptor_UBA");
- when By_Descriptor_S => Write_Str ("By_Descriptor_S");
- when By_Descriptor_SB => Write_Str ("By_Descriptor_SB");
- when By_Descriptor_A => Write_Str ("By_Descriptor_A");
- when By_Descriptor_NCA => Write_Str ("By_Descriptor_NCA");
+ when Default_Mechanism
+ => Write_Str ("Default");
+ when By_Copy
+ => Write_Str ("By_Copy");
+ when By_Reference
+ => Write_Str ("By_Reference");
+ when By_Descriptor
+ => Write_Str ("By_Descriptor");
+ when By_Descriptor_UBS
+ => Write_Str ("By_Descriptor_UBS");
+ when By_Descriptor_UBSB
+ => Write_Str ("By_Descriptor_UBSB");
+ when By_Descriptor_UBA
+ => Write_Str ("By_Descriptor_UBA");
+ when By_Descriptor_S
+ => Write_Str ("By_Descriptor_S");
+ when By_Descriptor_SB
+ => Write_Str ("By_Descriptor_SB");
+ when By_Descriptor_A
+ => Write_Str ("By_Descriptor_A");
+ when By_Descriptor_NCA
+ => Write_Str ("By_Descriptor_NCA");
+ when By_Short_Descriptor
+ => Write_Str ("By_Short_Descriptor");
+ when By_Short_Descriptor_UBS
+ => Write_Str ("By_Short_Descriptor_UBS");
+ when By_Short_Descriptor_UBSB
+ => Write_Str ("By_Short_Descriptor_UBSB");
+ when By_Short_Descriptor_UBA
+ => Write_Str ("By_Short_Descriptor_UBA");
+ when By_Short_Descriptor_S
+ => Write_Str ("By_Short_Descriptor_S");
+ when By_Short_Descriptor_SB
+ => Write_Str ("By_Short_Descriptor_SB");
+ when By_Short_Descriptor_A
+ => Write_Str ("By_Short_Descriptor_A");
+ when By_Short_Descriptor_NCA
+ => Write_Str ("By_Short_Descriptor_NCA");
when 1 .. Mechanism_Type'Last =>
Write_Str ("By_Copy if size <= ");
diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads
index 9b4bfb825e4..de9c54bfe5f 100644
--- a/gcc/ada/types.ads
+++ b/gcc/ada/types.ads
@@ -736,7 +736,7 @@ package Types is
-- passing mechanism. See specification of Sem_Mech for full details.
-- The following subtype is used to represent values of this type:
- subtype Mechanism_Type is Int range -10 .. Int'Last;
+ subtype Mechanism_Type is Int range -18 .. Int'Last;
-- Type used to represent a mechanism value. This is a subtype rather
-- than a type to avoid some annoying processing problems with certain
-- routines in Einfo (processing them to create the corresponding C).
diff --git a/gcc/ada/types.h b/gcc/ada/types.h
index fb218c203a6..1d4fd67065b 100644
--- a/gcc/ada/types.h
+++ b/gcc/ada/types.h
@@ -328,6 +328,15 @@ typedef Int Mechanism_Type;
#define By_Descriptor_A (-9)
#define By_Descriptor_NCA (-10)
#define By_Descriptor_Last (-10)
+#define By_Short_Descriptor (-11)
+#define By_Short_Descriptor_UBS (-12)
+#define By_Short_Descriptor_UBSB (-13)
+#define By_Short_Descriptor_UBA (-14)
+#define By_Short_Descriptor_S (-15)
+#define By_Short_Descriptor_SB (-16)
+#define By_Short_Descriptor_A (-17)
+#define By_Short_Descriptor_NCA (-18)
+#define By_Short_Descriptor_Last (-18)
/* Internal to Gigi. */
#define By_Copy_Return (-128)
diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads
index 3270e8f55b5..9f78cf72d33 100644
--- a/gcc/ada/vms_data.ads
+++ b/gcc/ada/vms_data.ads
@@ -1745,6 +1745,15 @@ package VMS_Data is
-- a body is compiled, the corresponding spec is also listed, along
-- with any subunits.
+ S_GCC_Machine : aliased constant S := "/MACHINE_CODE_LISTING " &
+ "-source-listing";
+ -- /NOMACHINE_CODE_LISTING (D)
+ -- /MACHINE_CODE_LISTING
+ --
+ -- Cause a full machine code listing of the file to be generated to
+ -- <filename>.lis. Interspersed source is included if the /DEBUG
+ -- qualifier is also present.
+
S_GCC_Mapping : aliased constant S := "/MAPPING_FILE=<" &
"-gnatem>";
-- /MAPPING_FILE=file_name
@@ -3316,6 +3325,7 @@ package VMS_Data is
S_GCC_Length 'Access,
S_GCC_List 'Access,
S_GCC_Output 'Access,
+ S_GCC_Machine 'Access,
S_GCC_Mapping 'Access,
S_GCC_Mess 'Access,
S_GCC_Nesting 'Access,
diff --git a/gcc/ada/xref_lib.adb b/gcc/ada/xref_lib.adb
index b09cc70e773..116f364bea1 100644
--- a/gcc/ada/xref_lib.adb
+++ b/gcc/ada/xref_lib.adb
@@ -903,7 +903,6 @@ package body Xref_Lib is
P_Line, P_Column : Natural;
pragma Warnings (Off, P_Line);
pragma Warnings (Off, P_Column);
-
begin
Ptr := Ptr + 1;
Parse_Number (Ali, Ptr, P_Line);
diff --git a/gcc/builtins.c b/gcc/builtins.c
index ca551915c50..2dffd53e604 100644
--- a/gcc/builtins.c
+++ b/gcc/builtins.c
@@ -207,6 +207,7 @@ static rtx expand_builtin_memory_chk (tree, rtx, enum machine_mode,
enum built_in_function);
static void maybe_emit_chk_warning (tree, enum built_in_function);
static void maybe_emit_sprintf_chk_warning (tree, enum built_in_function);
+static void maybe_emit_free_warning (tree);
static tree fold_builtin_object_size (tree, tree);
static tree fold_builtin_strcat_chk (tree, tree, tree, tree);
static tree fold_builtin_strncat_chk (tree, tree, tree, tree, tree);
@@ -6130,7 +6131,8 @@ expand_builtin (tree exp, rtx target, rtx subtarget, enum machine_mode mode,
if (!optimize
&& !called_as_built_in (fndecl)
&& DECL_ASSEMBLER_NAME_SET_P (fndecl)
- && fcode != BUILT_IN_ALLOCA)
+ && fcode != BUILT_IN_ALLOCA
+ && fcode != BUILT_IN_FREE)
return expand_call (exp, target, ignore);
/* The built-in function expanders test for target == const0_rtx
@@ -7007,6 +7009,10 @@ expand_builtin (tree exp, rtx target, rtx subtarget, enum machine_mode mode,
maybe_emit_sprintf_chk_warning (exp, fcode);
break;
+ case BUILT_IN_FREE:
+ maybe_emit_free_warning (exp);
+ break;
+
default: /* just do library call, if unknown builtin */
break;
}
@@ -11981,6 +11987,27 @@ maybe_emit_sprintf_chk_warning (tree exp, enum built_in_function fcode)
}
}
+/* Emit warning if a free is called with address of a variable. */
+
+static void
+maybe_emit_free_warning (tree exp)
+{
+ tree arg = CALL_EXPR_ARG (exp, 0);
+
+ STRIP_NOPS (arg);
+ if (TREE_CODE (arg) != ADDR_EXPR)
+ return;
+
+ arg = get_base_address (TREE_OPERAND (arg, 0));
+ if (arg == NULL || INDIRECT_REF_P (arg))
+ return;
+
+ if (SSA_VAR_P (arg))
+ warning (0, "%Kattempt to free a non-heap object %qD", exp, arg);
+ else
+ warning (0, "%Kattempt to free a non-heap object", exp);
+}
+
/* Fold a call to __builtin_object_size with arguments PTR and OST,
if possible. */
diff --git a/gcc/c-pch.c b/gcc/c-pch.c
index 3fde4611fab..520b866e30d 100644
--- a/gcc/c-pch.c
+++ b/gcc/c-pch.c
@@ -367,6 +367,7 @@ c_common_read_pch (cpp_reader *pfile, const char *name,
struct c_pch_header h;
struct save_macro_data *smd;
expanded_location saved_loc;
+ bool saved_trace_includes;
f = fdopen (fd, "rb");
if (f == NULL)
@@ -412,6 +413,7 @@ c_common_read_pch (cpp_reader *pfile, const char *name,
/* Save the location and then restore it after reading the PCH. */
saved_loc = expand_location (line_table->highest_line);
+ saved_trace_includes = line_table->trace_includes;
cpp_prepare_state (pfile, &smd);
@@ -425,6 +427,7 @@ c_common_read_pch (cpp_reader *pfile, const char *name,
fclose (f);
+ line_table->trace_includes = saved_trace_includes;
cpp_set_line_map (pfile, line_table);
linemap_add (line_table, LC_RENAME, 0, saved_loc.file, saved_loc.line);
diff --git a/gcc/cfgexpand.c b/gcc/cfgexpand.c
index 623ad85afb4..a943eff6ec1 100644
--- a/gcc/cfgexpand.c
+++ b/gcc/cfgexpand.c
@@ -2217,6 +2217,7 @@ expand_stack_alignment (void)
crtl->stack_realign_needed
= INCOMING_STACK_BOUNDARY < crtl->stack_alignment_estimated;
+ crtl->stack_realign_tried = crtl->stack_realign_needed;
crtl->stack_realign_processed = true;
@@ -2225,6 +2226,9 @@ expand_stack_alignment (void)
gcc_assert (targetm.calls.get_drap_rtx != NULL);
drap_rtx = targetm.calls.get_drap_rtx ();
+ /* stack_realign_drap and drap_rtx must match. */
+ gcc_assert ((stack_realign_drap != 0) == (drap_rtx != NULL));
+
/* Do nothing if NULL is returned, which means DRAP is not needed. */
if (NULL != drap_rtx)
{
diff --git a/gcc/config.gcc b/gcc/config.gcc
index ca3fe383bab..32faa0d415f 100644
--- a/gcc/config.gcc
+++ b/gcc/config.gcc
@@ -1542,7 +1542,7 @@ mips*-*-netbsd*) # NetBSD/mips, either endian.
target_cpu_default="MASK_ABICALLS"
tm_file="elfos.h ${tm_file} mips/elf.h netbsd.h netbsd-elf.h mips/netbsd.h"
;;
-mips64*-*-linux*)
+mips64*-*-linux* | mipsisa64*-*-linux*)
tm_file="dbxelf.h elfos.h svr4.h linux.h ${tm_file} mips/linux.h mips/linux64.h"
tmake_file="${tmake_file} mips/t-linux64"
tm_defines="${tm_defines} MIPS_ABI_DEFAULT=ABI_N32"
@@ -1551,6 +1551,9 @@ mips64*-*-linux*)
tm_file="${tm_file} mips/st.h"
tmake_file="${tmake_file} mips/t-st"
;;
+ mipsisa64r2*-*-linux*)
+ tm_defines="${tm_defines} MIPS_ISA_DEFAULT=65"
+ ;;
esac
gnu_ld=yes
gas=yes
diff --git a/gcc/config/i386/darwin.h b/gcc/config/i386/darwin.h
index c6ed10d8a72..a1defcf9bc6 100644
--- a/gcc/config/i386/darwin.h
+++ b/gcc/config/i386/darwin.h
@@ -75,6 +75,9 @@ along with GCC; see the file COPYING3. If not see
#undef STACK_BOUNDARY
#define STACK_BOUNDARY 128
+#undef MAIN_STACK_BOUNDARY
+#define MAIN_STACK_BOUNDARY 128
+
/* Since we'll never want a stack boundary less aligned than 128 bits
we need the extra work here otherwise bits of gcc get very grumpy
when we ask for lower alignment. We could just reject values less
diff --git a/gcc/config/i386/i386.c b/gcc/config/i386/i386.c
index 122db42061c..16130d8e64c 100644
--- a/gcc/config/i386/i386.c
+++ b/gcc/config/i386/i386.c
@@ -3088,9 +3088,9 @@ override_options (bool main_args_p)
ix86_force_align_arg_pointer = STACK_REALIGN_DEFAULT;
/* Validate -mincoming-stack-boundary= value or default it to
- ABI_STACK_BOUNDARY/PREFERRED_STACK_BOUNDARY. */
+ MIN_STACK_BOUNDARY/PREFERRED_STACK_BOUNDARY. */
if (ix86_force_align_arg_pointer)
- ix86_default_incoming_stack_boundary = ABI_STACK_BOUNDARY;
+ ix86_default_incoming_stack_boundary = MIN_STACK_BOUNDARY;
else
ix86_default_incoming_stack_boundary = PREFERRED_STACK_BOUNDARY;
ix86_incoming_stack_boundary = ix86_default_incoming_stack_boundary;
@@ -7719,10 +7719,10 @@ ix86_update_stack_boundary (void)
/* Incoming stack alignment can be changed on individual functions
via force_align_arg_pointer attribute. We use the smallest
incoming stack boundary. */
- if (ix86_incoming_stack_boundary > ABI_STACK_BOUNDARY
+ if (ix86_incoming_stack_boundary > MIN_STACK_BOUNDARY
&& lookup_attribute (ix86_force_align_arg_pointer_string,
TYPE_ATTRIBUTES (TREE_TYPE (current_function_decl))))
- ix86_incoming_stack_boundary = ABI_STACK_BOUNDARY;
+ ix86_incoming_stack_boundary = MIN_STACK_BOUNDARY;
/* Stack at entrance of main is aligned by runtime. We use the
smallest incoming stack boundary. */
@@ -7909,7 +7909,7 @@ ix86_expand_prologue (void)
if (stack_realign_fp)
{
int align_bytes = crtl->stack_alignment_needed / BITS_PER_UNIT;
- gcc_assert (align_bytes > STACK_BOUNDARY / BITS_PER_UNIT);
+ gcc_assert (align_bytes > MIN_STACK_BOUNDARY / BITS_PER_UNIT);
/* Align the stack. */
insn = emit_insn ((*ix86_gen_andsp) (stack_pointer_rtx,
diff --git a/gcc/config/i386/i386.h b/gcc/config/i386/i386.h
index c4696121c88..8376809cc52 100644
--- a/gcc/config/i386/i386.h
+++ b/gcc/config/i386/i386.h
@@ -653,14 +653,14 @@ enum target_cpu_default
/* Stack boundary of the main function guaranteed by OS. */
#define MAIN_STACK_BOUNDARY (TARGET_64BIT ? 128 : 32)
-/* Stack boundary guaranteed by ABI. */
-#define ABI_STACK_BOUNDARY (TARGET_64BIT ? 128 : 32)
+/* Minimum stack boundary. */
+#define MIN_STACK_BOUNDARY (TARGET_64BIT ? 128 : 32)
/* Boundary (in *bits*) on which the stack pointer prefers to be
aligned; the compiler cannot rely on having this alignment. */
#define PREFERRED_STACK_BOUNDARY ix86_preferred_stack_boundary
-/* It should be ABI_STACK_BOUNDARY. But we set it to 128 bits for
+/* It should be MIN_STACK_BOUNDARY. But we set it to 128 bits for
both 32bit and 64bit, to support codes that need 128 bit stack
alignment for SSE instructions, but can't realign the stack. */
#define PREFERRED_STACK_BOUNDARY_DEFAULT 128
diff --git a/gcc/config/mips/mips.c b/gcc/config/mips/mips.c
index 913acc71cf1..c4006c2f616 100644
--- a/gcc/config/mips/mips.c
+++ b/gcc/config/mips/mips.c
@@ -565,6 +565,8 @@ static const struct mips_cpu_info mips_cpu_info_table[] = {
{ "mips32", PROCESSOR_4KC, 32, PTF_AVOID_BRANCHLIKELY },
{ "mips32r2", PROCESSOR_M4K, 33, PTF_AVOID_BRANCHLIKELY },
{ "mips64", PROCESSOR_5KC, 64, PTF_AVOID_BRANCHLIKELY },
+ /* ??? For now just tune the generic MIPS64r2 for 5KC as well. */
+ { "mips64r2", PROCESSOR_5KC, 65, PTF_AVOID_BRANCHLIKELY },
/* MIPS I processors. */
{ "r3000", PROCESSOR_R3000, 1, 0 },
diff --git a/gcc/config/mips/mips.h b/gcc/config/mips/mips.h
index 8518a86233b..f5fc2e642ef 100644
--- a/gcc/config/mips/mips.h
+++ b/gcc/config/mips/mips.h
@@ -204,7 +204,7 @@ enum mips_code_readable_setting {
/* Generate mips16 code */
#define TARGET_MIPS16 ((target_flags & MASK_MIPS16) != 0)
-/* Generate mips16e code. Default 16bit ASE for mips32/mips32r2/mips64 */
+/* Generate mips16e code. Default 16bit ASE for mips32* and mips64* */
#define GENERATE_MIPS16E (TARGET_MIPS16 && mips_isa >= 32)
/* Generate mips16e register save/restore sequences. */
#define GENERATE_MIPS16E_SAVE_RESTORE (GENERATE_MIPS16E && mips_abi == ABI_32)
@@ -227,8 +227,12 @@ enum mips_code_readable_setting {
#define ISA_MIPS32 (mips_isa == 32)
#define ISA_MIPS32R2 (mips_isa == 33)
#define ISA_MIPS64 (mips_isa == 64)
+#define ISA_MIPS64R2 (mips_isa == 65)
/* Architecture target defines. */
+#define TARGET_LOONGSON_2E (mips_arch == PROCESSOR_LOONGSON_2E)
+#define TARGET_LOONGSON_2F (mips_arch == PROCESSOR_LOONGSON_2F)
+#define TARGET_LOONGSON_2EF (TARGET_LOONGSON_2E || TARGET_LOONGSON_2F)
#define TARGET_MIPS3900 (mips_arch == PROCESSOR_R3900)
#define TARGET_MIPS4000 (mips_arch == PROCESSOR_R4000)
#define TARGET_MIPS4120 (mips_arch == PROCESSOR_R4120)
@@ -240,11 +244,18 @@ enum mips_code_readable_setting {
#define TARGET_SB1 (mips_arch == PROCESSOR_SB1 \
|| mips_arch == PROCESSOR_SB1A)
#define TARGET_SR71K (mips_arch == PROCESSOR_SR71000)
-#define TARGET_LOONGSON_2E (mips_arch == PROCESSOR_LOONGSON_2E)
-#define TARGET_LOONGSON_2F (mips_arch == PROCESSOR_LOONGSON_2F)
-#define TARGET_LOONGSON_2EF (TARGET_LOONGSON_2E || TARGET_LOONGSON_2F)
/* Scheduling target defines. */
+#define TUNE_20KC (mips_tune == PROCESSOR_20KC)
+#define TUNE_24K (mips_tune == PROCESSOR_24KC \
+ || mips_tune == PROCESSOR_24KF2_1 \
+ || mips_tune == PROCESSOR_24KF1_1)
+#define TUNE_74K (mips_tune == PROCESSOR_74KC \
+ || mips_tune == PROCESSOR_74KF2_1 \
+ || mips_tune == PROCESSOR_74KF1_1 \
+ || mips_tune == PROCESSOR_74KF3_2)
+#define TUNE_LOONGSON_2EF (mips_tune == PROCESSOR_LOONGSON_2E \
+ || mips_tune == PROCESSOR_LOONGSON_2F)
#define TUNE_MIPS3000 (mips_tune == PROCESSOR_R3000)
#define TUNE_MIPS3900 (mips_tune == PROCESSOR_R3900)
#define TUNE_MIPS4000 (mips_tune == PROCESSOR_R4000)
@@ -258,16 +269,6 @@ enum mips_code_readable_setting {
#define TUNE_MIPS9000 (mips_tune == PROCESSOR_R9000)
#define TUNE_SB1 (mips_tune == PROCESSOR_SB1 \
|| mips_tune == PROCESSOR_SB1A)
-#define TUNE_24K (mips_tune == PROCESSOR_24KC \
- || mips_tune == PROCESSOR_24KF2_1 \
- || mips_tune == PROCESSOR_24KF1_1)
-#define TUNE_74K (mips_tune == PROCESSOR_74KC \
- || mips_tune == PROCESSOR_74KF2_1 \
- || mips_tune == PROCESSOR_74KF1_1 \
- || mips_tune == PROCESSOR_74KF3_2)
-#define TUNE_20KC (mips_tune == PROCESSOR_20KC)
-#define TUNE_LOONGSON_2EF (mips_tune == PROCESSOR_LOONGSON_2E \
- || mips_tune == PROCESSOR_LOONGSON_2F)
/* Whether vector modes and intrinsics for ST Microelectronics
Loongson-2E/2F processors should be enabled. In o32 pairs of
@@ -452,6 +453,12 @@ enum mips_code_readable_setting {
builtin_define ("__mips_isa_rev=1"); \
builtin_define ("_MIPS_ISA=_MIPS_ISA_MIPS64"); \
} \
+ else if (ISA_MIPS64R2) \
+ { \
+ builtin_define ("__mips=64"); \
+ builtin_define ("__mips_isa_rev=2"); \
+ builtin_define ("_MIPS_ISA=_MIPS_ISA_MIPS64"); \
+ } \
\
switch (mips_abi) \
{ \
@@ -619,7 +626,11 @@ enum mips_code_readable_setting {
# if MIPS_ISA_DEFAULT == 64
# define MULTILIB_ISA_DEFAULT "mips64"
# else
-# define MULTILIB_ISA_DEFAULT "mips1"
+# if MIPS_ISA_DEFAULT == 65
+# define MULTILIB_ISA_DEFAULT "mips64r2"
+# else
+# define MULTILIB_ISA_DEFAULT "mips1"
+# endif
# endif
# endif
# endif
@@ -670,6 +681,7 @@ enum mips_code_readable_setting {
%{march=mips32r2|march=m4k|march=4ke*|march=4ksd|march=24k* \
|march=34k*|march=74k*: -mips32r2} \
%{march=mips64|march=5k*|march=20k*|march=sb1*|march=sr71000: -mips64} \
+ %{march=mips64r2: -mips64r2} \
%{!march=*: -" MULTILIB_ISA_DEFAULT "}}"
/* A spec that infers a -mhard-float or -msoft-float setting from an
@@ -726,7 +738,8 @@ enum mips_code_readable_setting {
/* ISA has instructions for managing 64-bit fp and gp regs (e.g. mips3). */
#define ISA_HAS_64BIT_REGS (ISA_MIPS3 \
|| ISA_MIPS4 \
- || ISA_MIPS64)
+ || ISA_MIPS64 \
+ || ISA_MIPS64R2)
/* ISA has branch likely instructions (e.g. mips2). */
/* Disable branchlikely for tx39 until compare rewrite. They haven't
@@ -742,7 +755,8 @@ enum mips_code_readable_setting {
|| TARGET_MAD \
|| ISA_MIPS32 \
|| ISA_MIPS32R2 \
- || ISA_MIPS64) \
+ || ISA_MIPS64 \
+ || ISA_MIPS64R2) \
&& !TARGET_MIPS16)
/* ISA has the floating-point conditional move instructions introduced
@@ -750,7 +764,8 @@ enum mips_code_readable_setting {
#define ISA_HAS_FP_CONDMOVE ((ISA_MIPS4 \
|| ISA_MIPS32 \
|| ISA_MIPS32R2 \
- || ISA_MIPS64) \
+ || ISA_MIPS64 \
+ || ISA_MIPS64R2) \
&& !TARGET_MIPS5500 \
&& !TARGET_MIPS16)
@@ -766,18 +781,20 @@ enum mips_code_readable_setting {
#define ISA_HAS_8CC (ISA_MIPS4 \
|| ISA_MIPS32 \
|| ISA_MIPS32R2 \
- || ISA_MIPS64)
+ || ISA_MIPS64 \
+ || ISA_MIPS64R2)
/* This is a catch all for other mips4 instructions: indexed load, the
FP madd and msub instructions, and the FP recip and recip sqrt
instructions. */
#define ISA_HAS_FP4 ((ISA_MIPS4 \
|| (ISA_MIPS32R2 && TARGET_FLOAT64) \
- || ISA_MIPS64) \
+ || ISA_MIPS64 \
+ || ISA_MIPS64R2) \
&& !TARGET_MIPS16)
/* ISA has paired-single instructions. */
-#define ISA_HAS_PAIRED_SINGLE (ISA_MIPS32R2 || ISA_MIPS64)
+#define ISA_HAS_PAIRED_SINGLE (ISA_MIPS32R2 || ISA_MIPS64 || ISA_MIPS64R2)
/* ISA has conditional trap instructions. */
#define ISA_HAS_COND_TRAP (!ISA_MIPS1 \
@@ -786,7 +803,8 @@ enum mips_code_readable_setting {
/* ISA has integer multiply-accumulate instructions, madd and msub. */
#define ISA_HAS_MADD_MSUB ((ISA_MIPS32 \
|| ISA_MIPS32R2 \
- || ISA_MIPS64) \
+ || ISA_MIPS64 \
+ || ISA_MIPS64R2) \
&& !TARGET_MIPS16)
/* Integer multiply-accumulate instructions should be generated. */
@@ -803,7 +821,8 @@ enum mips_code_readable_setting {
#define ISA_HAS_NMADD4_NMSUB4(MODE) \
((ISA_MIPS4 \
|| (ISA_MIPS32R2 && (MODE) == V2SFmode) \
- || ISA_MIPS64) \
+ || ISA_MIPS64 \
+ || ISA_MIPS64R2) \
&& (!TARGET_MIPS5400 || TARGET_MAD) \
&& !TARGET_MIPS16)
@@ -815,7 +834,8 @@ enum mips_code_readable_setting {
/* ISA has count leading zeroes/ones instruction (not implemented). */
#define ISA_HAS_CLZ_CLO ((ISA_MIPS32 \
|| ISA_MIPS32R2 \
- || ISA_MIPS64) \
+ || ISA_MIPS64 \
+ || ISA_MIPS64R2) \
&& !TARGET_MIPS16)
/* ISA has three operand multiply instructions that put
@@ -855,6 +875,7 @@ enum mips_code_readable_setting {
/* ISA has the "ror" (rotate right) instructions. */
#define ISA_HAS_ROR ((ISA_MIPS32R2 \
+ || ISA_MIPS64R2 \
|| TARGET_MIPS5400 \
|| TARGET_MIPS5500 \
|| TARGET_SR71K \
@@ -865,7 +886,8 @@ enum mips_code_readable_setting {
#define ISA_HAS_PREFETCH ((ISA_MIPS4 \
|| ISA_MIPS32 \
|| ISA_MIPS32R2 \
- || ISA_MIPS64) \
+ || ISA_MIPS64 \
+ || ISA_MIPS64R2) \
&& !TARGET_MIPS16)
/* ISA has data indexed prefetch instructions. This controls use of
@@ -874,7 +896,8 @@ enum mips_code_readable_setting {
enabled.) */
#define ISA_HAS_PREFETCHX ((ISA_MIPS4 \
|| ISA_MIPS32R2 \
- || ISA_MIPS64) \
+ || ISA_MIPS64 \
+ || ISA_MIPS64R2) \
&& !TARGET_MIPS16)
/* True if trunc.w.s and trunc.w.d are real (not synthetic)
@@ -883,15 +906,19 @@ enum mips_code_readable_setting {
#define ISA_HAS_TRUNC_W (!ISA_MIPS1)
/* ISA includes the MIPS32r2 seb and seh instructions. */
-#define ISA_HAS_SEB_SEH (ISA_MIPS32R2 \
+#define ISA_HAS_SEB_SEH ((ISA_MIPS32R2 \
+ || ISA_MIPS64R2) \
&& !TARGET_MIPS16)
/* ISA includes the MIPS32/64 rev 2 ext and ins instructions. */
-#define ISA_HAS_EXT_INS (ISA_MIPS32R2 \
+#define ISA_HAS_EXT_INS ((ISA_MIPS32R2 \
+ || ISA_MIPS64R2) \
&& !TARGET_MIPS16)
/* ISA has instructions for accessing top part of 64-bit fp regs. */
-#define ISA_HAS_MXHC1 (TARGET_FLOAT64 && ISA_MIPS32R2)
+#define ISA_HAS_MXHC1 (TARGET_FLOAT64 \
+ && (ISA_MIPS32R2 \
+ || ISA_MIPS64R2))
/* ISA has lwxs instruction (load w/scaled index address. */
#define ISA_HAS_LWXS (TARGET_SMARTMIPS && !TARGET_MIPS16)
@@ -932,11 +959,14 @@ enum mips_code_readable_setting {
#define ISA_HAS_HILO_INTERLOCKS (ISA_MIPS32 \
|| ISA_MIPS32R2 \
|| ISA_MIPS64 \
+ || ISA_MIPS64R2 \
|| TARGET_MIPS5500 \
|| TARGET_LOONGSON_2EF)
/* ISA includes synci, jr.hb and jalr.hb. */
-#define ISA_HAS_SYNCI (ISA_MIPS32R2 && !TARGET_MIPS16)
+#define ISA_HAS_SYNCI ((ISA_MIPS32R2 \
+ || ISA_MIPS64R2) \
+ && !TARGET_MIPS16)
/* ISA includes sync. */
#define ISA_HAS_SYNC ((mips_isa >= 2 || TARGET_MIPS3900) && !TARGET_MIPS16)
@@ -1033,7 +1063,7 @@ enum mips_code_readable_setting {
#undef ASM_SPEC
#define ASM_SPEC "\
%{G*} %(endian_spec) %{mips1} %{mips2} %{mips3} %{mips4} \
-%{mips32} %{mips32r2} %{mips64} \
+%{mips32*} %{mips64*} \
%{mips16} %{mno-mips16:-no-mips16} \
%{mips3d} %{mno-mips3d:-no-mips3d} \
%{mdmx} %{mno-mdmx:-no-mdmx} \
@@ -1059,7 +1089,7 @@ enum mips_code_readable_setting {
#ifndef LINK_SPEC
#define LINK_SPEC "\
%(endian_spec) \
-%{G*} %{mips1} %{mips2} %{mips3} %{mips4} %{mips32} %{mips32r2} %{mips64} \
+%{G*} %{mips1} %{mips2} %{mips3} %{mips4} %{mips32*} %{mips64*} \
%{bestGnum} %{shared} %{non_shared}"
#endif /* LINK_SPEC defined */
@@ -1214,7 +1244,8 @@ enum mips_code_readable_setting {
/* The number of consecutive floating-point registers needed to store the
smallest format supported by the FPU. */
#define MIN_FPRS_PER_FMT \
- (ISA_MIPS32 || ISA_MIPS32R2 || ISA_MIPS64 ? 1 : MAX_FPRS_PER_FMT)
+ (ISA_MIPS32 || ISA_MIPS32R2 || ISA_MIPS64 || ISA_MIPS64R2 \
+ ? 1 : MAX_FPRS_PER_FMT)
/* The largest size of value that can be held in floating-point
registers and moved with a single instruction. */
diff --git a/gcc/config/sh/sh.c b/gcc/config/sh/sh.c
index 44723c4d4a6..60a940bbc84 100644
--- a/gcc/config/sh/sh.c
+++ b/gcc/config/sh/sh.c
@@ -260,7 +260,6 @@ static void sh_setup_incoming_varargs (CUMULATIVE_ARGS *, enum machine_mode, tre
static bool sh_strict_argument_naming (CUMULATIVE_ARGS *);
static bool sh_pretend_outgoing_varargs_named (CUMULATIVE_ARGS *);
static tree sh_build_builtin_va_list (void);
-static tree sh_canonical_va_list_type (tree);
static void sh_va_start (tree, rtx);
static tree sh_gimplify_va_arg_expr (tree, tree, gimple_seq *, gimple_seq *);
static bool sh_pass_by_reference (CUMULATIVE_ARGS *, enum machine_mode,
@@ -442,8 +441,6 @@ static int sh2a_function_vector_p (tree);
#undef TARGET_BUILD_BUILTIN_VA_LIST
#define TARGET_BUILD_BUILTIN_VA_LIST sh_build_builtin_va_list
-#undef TARGET_CANONICAL_VA_LIST_TYPE
-#define TARGET_CANONICAL_VA_LIST_TYPE sh_canonical_va_list_type
#undef TARGET_EXPAND_BUILTIN_VA_START
#define TARGET_EXPAND_BUILTIN_VA_START sh_va_start
#undef TARGET_GIMPLIFY_VA_ARG_EXPR
@@ -7148,14 +7145,6 @@ sh_build_builtin_va_list (void)
return record;
}
-/* Return always va_list_type_node. */
-
-static tree
-sh_canonical_va_list_type (tree type ATTRIBUTE_UNUSED)
-{
- return va_list_type_node;
-}
-
/* Implement `va_start' for varargs and stdarg. */
static void
diff --git a/gcc/configure b/gcc/configure
index 1b6925d92a8..a79664b708e 100755
--- a/gcc/configure
+++ b/gcc/configure
@@ -458,7 +458,7 @@ ac_includes_default="\
# include <unistd.h>
#endif"
-ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os target_noncanonical build_libsubdir build_subdir host_subdir target_subdir GENINSRC CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT GNATBIND ac_ct_GNATBIND GNATMAKE ac_ct_GNATMAKE NO_MINUS_C_MINUS_O OUTPUT_OPTION CPP EGREP loose_warn strict_warn warn_cflags nocommon_flag TREEBROWSER valgrind_path valgrind_path_defines valgrind_command coverage_flags enable_multilib enable_decimal_float enable_fixed_point enable_shared TARGET_SYSTEM_ROOT TARGET_SYSTEM_ROOT_DEFINE CROSS_SYSTEM_HEADER_DIR onestep PKGVERSION REPORT_BUGS_TO REPORT_BUGS_TEXI datarootdir docdir htmldir SET_MAKE AWK LN_S LN RANLIB ac_ct_RANLIB ranlib_flags INSTALL INSTALL_PROGRAM INSTALL_DATA make_compare_target have_mktemp_command MAKEINFO BUILD_INFO GENERATED_MANPAGES FLEX BISON NM AR COLLECT2_LIBS GNAT_LIBEXC LDEXP_LIB TARGET_GETGROUPS_T LIBICONV LTLIBICONV LIBICONV_DEP manext objext gthread_flags extra_modes_file extra_opt_files USE_NLS LIBINTL LIBINTL_DEP INCINTL XGETTEXT GMSGFMT POSUB CATALOGS DATADIRNAME INSTOBJEXT GENCAT CATOBJEXT host_cc_for_libada CROSS ALL SYSTEM_HEADER_DIR inhibit_libc CC_FOR_BUILD BUILD_CFLAGS BUILD_LDFLAGS STMP_FIXINC STMP_FIXPROTO collect2 LIBTOOL SED FGREP GREP LD DUMPBIN ac_ct_DUMPBIN ac_ct_AR STRIP ac_ct_STRIP lt_ECHO objdir enable_fast_install gcc_cv_as ORIGINAL_AS_FOR_TARGET gcc_cv_ld ORIGINAL_LD_FOR_TARGET gcc_cv_nm ORIGINAL_NM_FOR_TARGET gcc_cv_objdump libgcc_visibility GGC zlibdir zlibinc MAINT gcc_tooldir dollar slibdir subdirs srcdir all_compilers all_gtfiles all_lang_makefrags all_lang_makefiles all_languages all_selected_languages build_exeext build_install_headers_dir build_xm_file_list build_xm_include_list build_xm_defines build_file_translate check_languages cpp_install_dir xmake_file tmake_file extra_gcc_objs extra_headers_list extra_objs extra_parts extra_passes extra_programs float_h_file gcc_config_arguments gcc_gxx_include_dir host_exeext host_xm_file_list host_xm_include_list host_xm_defines out_host_hook_obj install lang_opt_files lang_specs_files lang_tree_files local_prefix md_file objc_boehm_gc out_file out_object_file thread_file tm_file_list tm_include_list tm_defines tm_p_file_list tm_p_include_list xm_file_list xm_include_list xm_defines c_target_objs cxx_target_objs fortran_target_objs target_cpu_default GMPLIBS GMPINC LIBOBJS LTLIBOBJS'
+ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os target_noncanonical build_libsubdir build_subdir host_subdir target_subdir GENINSRC CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT GNATBIND ac_ct_GNATBIND GNATMAKE ac_ct_GNATMAKE NO_MINUS_C_MINUS_O OUTPUT_OPTION CPP EGREP loose_warn strict_warn warn_cflags nocommon_flag TREEBROWSER valgrind_path valgrind_path_defines valgrind_command coverage_flags enable_multilib enable_decimal_float enable_fixed_point enable_shared TARGET_SYSTEM_ROOT TARGET_SYSTEM_ROOT_DEFINE CROSS_SYSTEM_HEADER_DIR onestep PKGVERSION REPORT_BUGS_TO REPORT_BUGS_TEXI datarootdir docdir htmldir SET_MAKE AWK LN_S LN RANLIB ac_ct_RANLIB ranlib_flags INSTALL INSTALL_PROGRAM INSTALL_DATA make_compare_target have_mktemp_command MAKEINFO BUILD_INFO GENERATED_MANPAGES FLEX BISON NM AR COLLECT2_LIBS GNAT_LIBEXC LDEXP_LIB TARGET_GETGROUPS_T LIBICONV LTLIBICONV LIBICONV_DEP manext objext gthread_flags extra_modes_file extra_opt_files USE_NLS LIBINTL LIBINTL_DEP INCINTL XGETTEXT GMSGFMT POSUB CATALOGS DATADIRNAME INSTOBJEXT GENCAT CATOBJEXT CROSS ALL SYSTEM_HEADER_DIR inhibit_libc CC_FOR_BUILD BUILD_CFLAGS BUILD_LDFLAGS STMP_FIXINC STMP_FIXPROTO collect2 LIBTOOL SED FGREP GREP LD DUMPBIN ac_ct_DUMPBIN ac_ct_AR STRIP ac_ct_STRIP lt_ECHO objdir enable_fast_install gcc_cv_as ORIGINAL_AS_FOR_TARGET gcc_cv_ld ORIGINAL_LD_FOR_TARGET gcc_cv_nm ORIGINAL_NM_FOR_TARGET gcc_cv_objdump libgcc_visibility GGC zlibdir zlibinc MAINT gcc_tooldir dollar slibdir subdirs srcdir all_compilers all_gtfiles all_lang_makefrags all_lang_makefiles all_languages all_selected_languages build_exeext build_install_headers_dir build_xm_file_list build_xm_include_list build_xm_defines build_file_translate check_languages cpp_install_dir xmake_file tmake_file extra_gcc_objs extra_headers_list extra_objs extra_parts extra_passes extra_programs float_h_file gcc_config_arguments gcc_gxx_include_dir host_exeext host_xm_file_list host_xm_include_list host_xm_defines out_host_hook_obj install lang_opt_files lang_specs_files lang_tree_files local_prefix md_file objc_boehm_gc out_file out_object_file thread_file tm_file_list tm_include_list tm_defines tm_p_file_list tm_p_include_list xm_file_list xm_include_list xm_defines c_target_objs cxx_target_objs fortran_target_objs target_cpu_default GMPLIBS GMPINC LIBOBJS LTLIBOBJS'
ac_subst_files='language_hooks'
ac_pwd=`pwd`
@@ -13964,10 +13964,6 @@ do
done
tmake_file="${tmake_file_}"
-# This is a terrible hack which will go away some day.
-host_cc_for_libada=${CC}
-
-
out_object_file=`basename $out_file .c`.o
tm_file_list="options.h"
@@ -14725,13 +14721,13 @@ if test "${lt_cv_nm_interface+set}" = set; then
else
lt_cv_nm_interface="BSD nm"
echo "int some_variable = 0;" > conftest.$ac_ext
- (eval echo "\"\$as_me:14728: $ac_compile\"" >&5)
+ (eval echo "\"\$as_me:14724: $ac_compile\"" >&5)
(eval "$ac_compile" 2>conftest.err)
cat conftest.err >&5
- (eval echo "\"\$as_me:14731: $NM \\\"conftest.$ac_objext\\\"\"" >&5)
+ (eval echo "\"\$as_me:14727: $NM \\\"conftest.$ac_objext\\\"\"" >&5)
(eval "$NM \"conftest.$ac_objext\"" 2>conftest.err > conftest.out)
cat conftest.err >&5
- (eval echo "\"\$as_me:14734: output\"" >&5)
+ (eval echo "\"\$as_me:14730: output\"" >&5)
cat conftest.out >&5
if $GREP 'External.*some_variable' conftest.out > /dev/null; then
lt_cv_nm_interface="MS dumpbin"
@@ -15786,7 +15782,7 @@ ia64-*-hpux*)
;;
*-*-irix6*)
# Find out which ABI we are using.
- echo '#line 15789 "configure"' > conftest.$ac_ext
+ echo '#line 15785 "configure"' > conftest.$ac_ext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
(eval $ac_compile) 2>&5
ac_status=$?
@@ -16406,11 +16402,11 @@ else
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
- (eval echo "\"\$as_me:16409: $lt_compile\"" >&5)
+ (eval echo "\"\$as_me:16405: $lt_compile\"" >&5)
(eval "$lt_compile" 2>conftest.err)
ac_status=$?
cat conftest.err >&5
- echo "$as_me:16413: \$? = $ac_status" >&5
+ echo "$as_me:16409: \$? = $ac_status" >&5
if (exit $ac_status) && test -s "$ac_outfile"; then
# The compiler can only warn and ignore the option if not recognized
# So say no if there are warnings other than the usual output.
@@ -16728,11 +16724,11 @@ else
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
- (eval echo "\"\$as_me:16731: $lt_compile\"" >&5)
+ (eval echo "\"\$as_me:16727: $lt_compile\"" >&5)
(eval "$lt_compile" 2>conftest.err)
ac_status=$?
cat conftest.err >&5
- echo "$as_me:16735: \$? = $ac_status" >&5
+ echo "$as_me:16731: \$? = $ac_status" >&5
if (exit $ac_status) && test -s "$ac_outfile"; then
# The compiler can only warn and ignore the option if not recognized
# So say no if there are warnings other than the usual output.
@@ -16833,11 +16829,11 @@ else
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
- (eval echo "\"\$as_me:16836: $lt_compile\"" >&5)
+ (eval echo "\"\$as_me:16832: $lt_compile\"" >&5)
(eval "$lt_compile" 2>out/conftest.err)
ac_status=$?
cat out/conftest.err >&5
- echo "$as_me:16840: \$? = $ac_status" >&5
+ echo "$as_me:16836: \$? = $ac_status" >&5
if (exit $ac_status) && test -s out/conftest2.$ac_objext
then
# The compiler can only warn and ignore the option if not recognized
@@ -16888,11 +16884,11 @@ else
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
- (eval echo "\"\$as_me:16891: $lt_compile\"" >&5)
+ (eval echo "\"\$as_me:16887: $lt_compile\"" >&5)
(eval "$lt_compile" 2>out/conftest.err)
ac_status=$?
cat out/conftest.err >&5
- echo "$as_me:16895: \$? = $ac_status" >&5
+ echo "$as_me:16891: \$? = $ac_status" >&5
if (exit $ac_status) && test -s out/conftest2.$ac_objext
then
# The compiler can only warn and ignore the option if not recognized
@@ -19685,7 +19681,7 @@ else
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF
-#line 19688 "configure"
+#line 19684 "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
@@ -19785,7 +19781,7 @@ else
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF
-#line 19788 "configure"
+#line 19784 "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
@@ -23587,7 +23583,7 @@ lang_tree_files=
# `language' must be a single word so is spelled singularly.
all_languages=
all_compilers=
-all_outputs='Makefile gccbug libada-mk'
+all_outputs='Makefile gccbug'
# List of language makefile fragments.
all_lang_makefrags=
# List of language subdirectory makefiles. Deprecated.
@@ -24614,7 +24610,6 @@ s,@DATADIRNAME@,$DATADIRNAME,;t t
s,@INSTOBJEXT@,$INSTOBJEXT,;t t
s,@GENCAT@,$GENCAT,;t t
s,@CATOBJEXT@,$CATOBJEXT,;t t
-s,@host_cc_for_libada@,$host_cc_for_libada,;t t
s,@CROSS@,$CROSS,;t t
s,@ALL@,$ALL,;t t
s,@SYSTEM_HEADER_DIR@,$SYSTEM_HEADER_DIR,;t t
diff --git a/gcc/configure.ac b/gcc/configure.ac
index aee90f36848..ced1a7cd21b 100644
--- a/gcc/configure.ac
+++ b/gcc/configure.ac
@@ -1607,10 +1607,6 @@ do
done
tmake_file="${tmake_file_}"
-# This is a terrible hack which will go away some day.
-host_cc_for_libada=${CC}
-AC_SUBST(host_cc_for_libada)
-
out_object_file=`basename $out_file .c`.o
tm_file_list="options.h"
@@ -3569,7 +3565,7 @@ lang_tree_files=
# `language' must be a single word so is spelled singularly.
all_languages=
all_compilers=
-all_outputs='Makefile gccbug libada-mk'
+all_outputs='Makefile gccbug'
# List of language makefile fragments.
all_lang_makefrags=
# List of language subdirectory makefiles. Deprecated.
diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog
index e98283ad6ca..c865326d0bc 100644
--- a/gcc/cp/ChangeLog
+++ b/gcc/cp/ChangeLog
@@ -1,3 +1,24 @@
+2008-07-31 Jakub Jelinek <jakub@redhat.com>
+
+ PR c++/36405
+ * rtti.c (get_tinfo_decl_dynamic, get_typeid): Call
+ complete_type_or_else even for UNKNOWN_TYPE to get diagnostics.
+
+2008-07-31 Jason Merrill <jason@redhat.com>
+
+ PR c++/36633
+ * init.c (build_new_1): Don't convert pointer to the data type
+ until we're actually going to treat it as that type.
+
+ PR c++/11309
+ * tree.c (build_aggr_init_expr): Split out...
+ (build_cplus_new): ...from here.
+ (stabilize_init): Don't mess with AGGR_INIT_EXPR either.
+ * init.c (build_new_1): new T() means value-initialization,
+ not default-initialization.
+ (build_vec_init): Likewise.
+ (build_value_init_1): Use build_aggr_init_expr.
+
2008-07-30 Dodji Seketeli <dseketel@redhat.com>
PR c++/36767
diff --git a/gcc/cp/cp-tree.h b/gcc/cp/cp-tree.h
index f9a2af8bb01..02d358a8fe6 100644
--- a/gcc/cp/cp-tree.h
+++ b/gcc/cp/cp-tree.h
@@ -4742,6 +4742,7 @@ extern tree build_min_nt (enum tree_code, ...);
extern tree build_min_non_dep (enum tree_code, tree, ...);
extern tree build_min_non_dep_call_list (tree, tree, tree);
extern tree build_cplus_new (tree, tree);
+extern tree build_aggr_init_expr (tree, tree);
extern tree get_target_expr (tree);
extern tree build_cplus_array_type (tree, tree);
extern tree build_array_of_n_type (tree, int);
diff --git a/gcc/cp/init.c b/gcc/cp/init.c
index 3deb85d432b..c6d63b84096 100644
--- a/gcc/cp/init.c
+++ b/gcc/cp/init.c
@@ -347,7 +347,7 @@ build_value_init_1 (tree type, bool have_ctor)
if (CLASS_TYPE_P (type))
{
if (type_has_user_provided_constructor (type) && !have_ctor)
- return build_cplus_new
+ return build_aggr_init_expr
(type,
build_special_member_call (NULL_TREE, complete_ctor_identifier,
NULL_TREE, type, LOOKUP_NORMAL,
@@ -511,7 +511,7 @@ perform_member_init (tree member, tree init)
{
/* Initialization of one array from another. */
finish_expr_stmt (build_vec_init (decl, NULL_TREE, TREE_VALUE (init),
- /*explicit_default_init_p=*/false,
+ /*explicit_value_init_p=*/false,
/* from_array=*/1,
tf_warning_or_error));
}
@@ -1286,7 +1286,7 @@ build_aggr_init (tree exp, tree init, int flags, tsubst_flags_t complain)
if (itype && cp_type_quals (itype) != TYPE_UNQUALIFIED)
itype = TREE_TYPE (init) = TYPE_MAIN_VARIANT (itype);
stmt_expr = build_vec_init (exp, NULL_TREE, init,
- /*explicit_default_init_p=*/false,
+ /*explicit_value_init_p=*/false,
itype && same_type_p (itype,
TREE_TYPE (exp)),
complain);
@@ -2055,11 +2055,9 @@ build_new_1 (tree placement, tree type, tree nelts, tree init,
return rval;
}
- /* While we're working, use a pointer to the type we've actually
- allocated. Store the result of the call in a variable so that we
- can use it more than once. */
- full_pointer_type = build_pointer_type (full_type);
- alloc_expr = get_target_expr (build_nop (full_pointer_type, alloc_call));
+ /* Store the result of the allocation call in a variable so that we can
+ use it more than once. */
+ alloc_expr = get_target_expr (alloc_call);
alloc_node = TARGET_EXPR_SLOT (alloc_expr);
/* Strip any COMPOUND_EXPRs from ALLOC_CALL. */
@@ -2111,16 +2109,17 @@ build_new_1 (tree placement, tree type, tree nelts, tree init,
tree size_ptr_type;
/* Adjust so we're pointing to the start of the object. */
- data_addr = get_target_expr (build2 (POINTER_PLUS_EXPR, full_pointer_type,
- alloc_node, cookie_size));
+ data_addr = build2 (POINTER_PLUS_EXPR, TREE_TYPE (alloc_node),
+ alloc_node, cookie_size);
/* Store the number of bytes allocated so that we can know how
many elements to destroy later. We use the last sizeof
(size_t) bytes to store the number of elements. */
- cookie_ptr = fold_build1 (NEGATE_EXPR, sizetype, size_in_bytes (sizetype));
+ cookie_ptr = size_binop (MINUS_EXPR, cookie_size, size_in_bytes (sizetype));
+ cookie_ptr = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (alloc_node),
+ alloc_node, cookie_ptr);
size_ptr_type = build_pointer_type (sizetype);
- cookie_ptr = build2 (POINTER_PLUS_EXPR, size_ptr_type,
- fold_convert (size_ptr_type, data_addr), cookie_ptr);
+ cookie_ptr = fold_convert (size_ptr_type, cookie_ptr);
cookie = cp_build_indirect_ref (cookie_ptr, NULL, complain);
cookie_expr = build2 (MODIFY_EXPR, sizetype, cookie, nelts);
@@ -2134,11 +2133,10 @@ build_new_1 (tree placement, tree type, tree nelts, tree init,
cookie = cp_build_indirect_ref (cookie_ptr, NULL, complain);
cookie = build2 (MODIFY_EXPR, sizetype, cookie,
- size_in_bytes(elt_type));
+ size_in_bytes (elt_type));
cookie_expr = build2 (COMPOUND_EXPR, TREE_TYPE (cookie_expr),
cookie, cookie_expr);
}
- data_addr = TARGET_EXPR_SLOT (data_addr);
}
else
{
@@ -2146,6 +2144,10 @@ build_new_1 (tree placement, tree type, tree nelts, tree init,
data_addr = alloc_node;
}
+ /* Now use a pointer to the type we've actually allocated. */
+ full_pointer_type = build_pointer_type (full_type);
+ data_addr = fold_convert (full_pointer_type, data_addr);
+
/* Now initialize the allocated object. Note that we preevaluate the
initialization expression, apart from the actual constructor call or
assignment--we do this because we want to delay the allocation as long
@@ -2154,19 +2156,19 @@ build_new_1 (tree placement, tree type, tree nelts, tree init,
if (is_initialized)
{
bool stable;
+ bool explicit_value_init_p = false;
init_expr = cp_build_indirect_ref (data_addr, NULL, complain);
- if (array_p)
+ if (init == void_zero_node)
{
- bool explicit_default_init_p = false;
+ init = NULL_TREE;
+ explicit_value_init_p = true;
+ }
- if (init == void_zero_node)
- {
- init = NULL_TREE;
- explicit_default_init_p = true;
- }
- else if (init)
+ if (array_p)
+ {
+ if (init)
{
if (complain & tf_error)
permerror ("ISO C++ forbids initialization in array new");
@@ -2179,7 +2181,7 @@ build_new_1 (tree placement, tree type, tree nelts, tree init,
integer_one_node,
complain),
init,
- explicit_default_init_p,
+ explicit_value_init_p,
/*from_array=*/0,
complain);
@@ -2190,17 +2192,19 @@ build_new_1 (tree placement, tree type, tree nelts, tree init,
}
else
{
- if (init == void_zero_node)
- init = build_default_init (full_type, nelts);
-
- if (TYPE_NEEDS_CONSTRUCTING (type))
+ if (TYPE_NEEDS_CONSTRUCTING (type) && !explicit_value_init_p)
{
init_expr = build_special_member_call (init_expr,
complete_ctor_identifier,
init, elt_type,
LOOKUP_NORMAL,
complain);
- stable = stabilize_init (init_expr, &init_preeval_expr);
+ }
+ else if (explicit_value_init_p)
+ {
+ /* Something like `new int()'. */
+ init_expr = build2 (INIT_EXPR, full_type,
+ init_expr, build_value_init (full_type));
}
else
{
@@ -2216,8 +2220,8 @@ build_new_1 (tree placement, tree type, tree nelts, tree init,
init_expr = cp_build_modify_expr (init_expr, INIT_EXPR, init,
complain);
- stable = stabilize_init (init_expr, &init_preeval_expr);
}
+ stable = stabilize_init (init_expr, &init_preeval_expr);
}
if (init_expr == error_mark_node)
@@ -2239,11 +2243,13 @@ build_new_1 (tree placement, tree type, tree nelts, tree init,
/* The Standard is unclear here, but the right thing to do
is to use the same method for finding deallocation
functions that we use for finding allocation functions. */
- cleanup = build_op_delete_call (dcode, alloc_node, size,
- globally_qualified_p,
- (placement_allocation_fn_p
- ? alloc_call : NULL_TREE),
- alloc_fn);
+ cleanup = (build_op_delete_call
+ (dcode,
+ fold_convert (full_pointer_type, alloc_node),
+ size,
+ globally_qualified_p,
+ placement_allocation_fn_p ? alloc_call : NULL_TREE,
+ alloc_fn));
if (!cleanup)
/* We're done. */;
@@ -2298,7 +2304,7 @@ build_new_1 (tree placement, tree type, tree nelts, tree init,
if (cookie_expr)
rval = build2 (COMPOUND_EXPR, TREE_TYPE (rval), cookie_expr, rval);
- if (rval == alloc_node)
+ if (rval == data_addr)
/* If we don't have an initializer or a cookie, strip the TARGET_EXPR
and return the call (which doesn't need to be adjusted). */
rval = TARGET_EXPR_INITIAL (alloc_expr);
@@ -2662,8 +2668,8 @@ get_temp_regvar (tree type, tree init)
INIT is the (possibly NULL) initializer.
- If EXPLICIT_DEFAULT_INIT_P is true, then INIT must be NULL. All
- elements in the array are default-initialized.
+ If EXPLICIT_VALUE_INIT_P is true, then INIT must be NULL. All
+ elements in the array are value-initialized.
FROM_ARRAY is 0 if we should init everything with INIT
(i.e., every element initialized from INIT).
@@ -2674,7 +2680,7 @@ get_temp_regvar (tree type, tree init)
tree
build_vec_init (tree base, tree maxindex, tree init,
- bool explicit_default_init_p,
+ bool explicit_value_init_p,
int from_array, tsubst_flags_t complain)
{
tree rval;
@@ -2704,7 +2710,7 @@ build_vec_init (tree base, tree maxindex, tree init,
if (maxindex == NULL_TREE || maxindex == error_mark_node)
return error_mark_node;
- if (explicit_default_init_p)
+ if (explicit_value_init_p)
gcc_assert (!init);
inner_elt_type = strip_array_types (atype);
@@ -2840,7 +2846,7 @@ build_vec_init (tree base, tree maxindex, tree init,
We do need to keep going if we're copying an array. */
if (from_array
- || ((TYPE_NEEDS_CONSTRUCTING (type) || explicit_default_init_p)
+ || ((TYPE_NEEDS_CONSTRUCTING (type) || explicit_value_init_p)
&& ! (host_integerp (maxindex, 0)
&& (num_initialized_elts
== tree_low_cst (maxindex, 0) + 1))))
@@ -2889,17 +2895,17 @@ build_vec_init (tree base, tree maxindex, tree init,
("cannot initialize multi-dimensional array with initializer");
elt_init = build_vec_init (build1 (INDIRECT_REF, type, base),
0, 0,
- /*explicit_default_init_p=*/false,
+ explicit_value_init_p,
0, complain);
}
- else if (!TYPE_NEEDS_CONSTRUCTING (type))
- elt_init = (cp_build_modify_expr
- (to, INIT_EXPR,
- build_zero_init (type, size_one_node,
- /*static_storage_p=*/false),
- complain));
+ else if (explicit_value_init_p)
+ elt_init = build2 (INIT_EXPR, type, to,
+ build_value_init (type));
else
- elt_init = build_aggr_init (to, init, 0, complain);
+ {
+ gcc_assert (TYPE_NEEDS_CONSTRUCTING (type));
+ elt_init = build_aggr_init (to, init, 0, complain);
+ }
current_stmt_tree ()->stmts_are_full_exprs_p = 1;
finish_expr_stmt (elt_init);
diff --git a/gcc/cp/rtti.c b/gcc/cp/rtti.c
index d2e544b0f9e..e3e5349f5ca 100644
--- a/gcc/cp/rtti.c
+++ b/gcc/cp/rtti.c
@@ -252,7 +252,8 @@ get_tinfo_decl_dynamic (tree exp)
/* Peel off cv qualifiers. */
type = TYPE_MAIN_VARIANT (type);
- if (CLASS_TYPE_P (type))
+ /* For UNKNOWN_TYPEs call complete_type_or_else to get diagnostics. */
+ if (CLASS_TYPE_P (type) || TREE_CODE (type) == UNKNOWN_TYPE)
type = complete_type_or_else (type, exp);
if (!type)
@@ -459,7 +460,8 @@ get_typeid (tree type)
that is the operand of typeid are always ignored. */
type = TYPE_MAIN_VARIANT (type);
- if (CLASS_TYPE_P (type))
+ /* For UNKNOWN_TYPEs call complete_type_or_else to get diagnostics. */
+ if (CLASS_TYPE_P (type) || TREE_CODE (type) == UNKNOWN_TYPE)
type = complete_type_or_else (type, NULL_TREE);
if (!type)
diff --git a/gcc/cp/tree.c b/gcc/cp/tree.c
index 50c3049c3d0..4114f868d41 100644
--- a/gcc/cp/tree.c
+++ b/gcc/cp/tree.c
@@ -339,15 +339,17 @@ build_aggr_init_array (tree return_type, tree fn, tree slot, int nargs,
}
/* INIT is a CALL_EXPR or AGGR_INIT_EXPR which needs info about its
- target. TYPE is the type that this initialization should appear to
- have.
+ target. TYPE is the type to be initialized.
- Build an encapsulation of the initialization to perform
- and return it so that it can be processed by language-independent
- and language-specific expression expanders. */
+ Build an AGGR_INIT_EXPR to represent the initialization. This function
+ differs from build_cplus_new in that an AGGR_INIT_EXPR can only be used
+ to initialize another object, whereas a TARGET_EXPR can either
+ initialize another object or create its own temporary object, and as a
+ result building up a TARGET_EXPR requires that the type's destructor be
+ callable. */
tree
-build_cplus_new (tree type, tree init)
+build_aggr_init_expr (tree type, tree init)
{
tree fn;
tree slot;
@@ -369,8 +371,6 @@ build_cplus_new (tree type, tree init)
&& TREE_CODE (TREE_OPERAND (fn, 0)) == FUNCTION_DECL
&& DECL_CONSTRUCTOR_P (TREE_OPERAND (fn, 0)));
- slot = build_local_temp (type);
-
/* We split the CALL_EXPR into its function and its arguments here.
Then, in expand_expr, we put them back together. The reason for
this is that this expression might be a default argument
@@ -384,6 +384,8 @@ build_cplus_new (tree type, tree init)
type, don't mess with AGGR_INIT_EXPR. */
if (is_ctor || TREE_ADDRESSABLE (type))
{
+ slot = build_local_temp (type);
+
if (TREE_CODE(init) == CALL_EXPR)
rval = build_aggr_init_array (void_type_node, fn, slot,
call_expr_nargs (init),
@@ -398,6 +400,30 @@ build_cplus_new (tree type, tree init)
else
rval = init;
+ return rval;
+}
+
+/* INIT is a CALL_EXPR or AGGR_INIT_EXPR which needs info about its
+ target. TYPE is the type that this initialization should appear to
+ have.
+
+ Build an encapsulation of the initialization to perform
+ and return it so that it can be processed by language-independent
+ and language-specific expression expanders. */
+
+tree
+build_cplus_new (tree type, tree init)
+{
+ tree rval = build_aggr_init_expr (type, init);
+ tree slot;
+
+ if (TREE_CODE (rval) == AGGR_INIT_EXPR)
+ slot = AGGR_INIT_EXPR_SLOT (rval);
+ else if (TREE_CODE (rval) == CALL_EXPR)
+ slot = build_local_temp (type);
+ else
+ return rval;
+
rval = build_target_expr (slot, rval);
TARGET_EXPR_IMPLICIT_P (rval) = 1;
@@ -2687,7 +2713,8 @@ stabilize_init (tree init, tree *initp)
return true;
if (TREE_CODE (t) == INIT_EXPR
- && TREE_CODE (TREE_OPERAND (t, 1)) != TARGET_EXPR)
+ && TREE_CODE (TREE_OPERAND (t, 1)) != TARGET_EXPR
+ && TREE_CODE (TREE_OPERAND (t, 1)) != AGGR_INIT_EXPR)
{
TREE_OPERAND (t, 1) = stabilize_expr (TREE_OPERAND (t, 1), initp);
return true;
diff --git a/gcc/cp/typeck.c b/gcc/cp/typeck.c
index ba1d0286079..feb6b5f8f54 100644
--- a/gcc/cp/typeck.c
+++ b/gcc/cp/typeck.c
@@ -6114,7 +6114,7 @@ cp_build_modify_expr (tree lhs, enum tree_code modifycode, tree rhs,
from_array = TREE_CODE (TREE_TYPE (newrhs)) == ARRAY_TYPE
? 1 + (modifycode != INIT_EXPR): 0;
return build_vec_init (lhs, NULL_TREE, newrhs,
- /*explicit_default_init_p=*/false,
+ /*explicit_value_init_p=*/false,
from_array, complain);
}
diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi
index 764edc22b18..c2495b32aec 100644
--- a/gcc/doc/invoke.texi
+++ b/gcc/doc/invoke.texi
@@ -629,7 +629,8 @@ Objective-C and Objective-C++ Dialects}.
@emph{MIPS Options}
@gccoptlist{-EL -EB -march=@var{arch} -mtune=@var{arch} @gol
--mips1 -mips2 -mips3 -mips4 -mips32 -mips32r2 -mips64 @gol
+-mips1 -mips2 -mips3 -mips4 -mips32 -mips32r2 @gol
+-mips64 -mips64r2 @gol
-mips16 -mno-mips16 -mflip-mips16 @gol
-minterlink-mips16 -mno-interlink-mips16 @gol
-mabi=@var{abi} -mabicalls -mno-abicalls @gol
@@ -2696,7 +2697,7 @@ Options} and @ref{Objective-C and Objective-C++ Dialect Options}.
-Wstrict-overflow=1 @gol
-Wswitch @gol
-Wtrigraphs @gol
--Wuninitialized @r{(only with} @option{-O1} @r{and above)} @gol
+-Wuninitialized @gol
-Wunknown-pragmas @gol
-Wunused-function @gol
-Wunused-label @gol
@@ -2730,7 +2731,7 @@ name is still supported, but the newer name is more descriptive.)
-Woverride-init @gol
-Wsign-compare @gol
-Wtype-limits @gol
--Wuninitialized @r{(only with} @option{-O1} @r{and above)} @gol
+-Wuninitialized @gol
-Wunused-parameter @r{(only with} @option{-Wunused} @r{or} @option{-Wall}@r{)} @gol
}
@@ -2892,8 +2893,7 @@ can be disabled with the @option{-Wno-nonnull} option.
@opindex Winit-self
@opindex Wno-init-self
Warn about uninitialized variables which are initialized with themselves.
-Note this option can only be used with the @option{-Wuninitialized} option,
-which in turn only works with @option{-O1} and above.
+Note this option can only be used with the @option{-Wuninitialized} option.
For example, GCC will warn about @code{i} being uninitialized in the
following snippet only when @option{-Winit-self} has been specified:
@@ -3176,12 +3176,6 @@ either specify @samp{-Wextra -Wunused} (note that @samp{-Wall} implies
Warn if an automatic variable is used without first being initialized or
if a variable may be clobbered by a @code{setjmp} call.
-These warnings are possible only in optimizing compilation,
-because they require data flow information that is computed only
-when optimizing. If you do not specify @option{-O}, you will not get
-these warnings. Instead, GCC will issue a warning about @option{-Wuninitialized}
-requiring @option{-O}.
-
If you want to warn about code which uses the uninitialized value of the
variable in its own initializer, use the @option{-Winit-self} option.
@@ -3252,8 +3246,7 @@ Some spurious warnings can be avoided if you declare all the functions
you use that never return as @code{noreturn}. @xref{Function
Attributes}.
-This warning is enabled by @option{-Wall} or @option{-Wextra} in
-optimizing compilations (@option{-O1} and above).
+This warning is enabled by @option{-Wall} or @option{-Wextra}.
@item -Wunknown-pragmas
@opindex Wunknown-pragmas
@@ -11971,7 +11964,7 @@ Generate code that will run on @var{arch}, which can be the name of a
generic MIPS ISA, or the name of a particular processor.
The ISA names are:
@samp{mips1}, @samp{mips2}, @samp{mips3}, @samp{mips4},
-@samp{mips32}, @samp{mips32r2}, and @samp{mips64}.
+@samp{mips32}, @samp{mips32r2}, @samp{mips64} and @samp{mips64r2}.
The processor names are:
@samp{4kc}, @samp{4km}, @samp{4kp}, @samp{4ksc},
@samp{4kec}, @samp{4kem}, @samp{4kep}, @samp{4ksd},
@@ -12073,6 +12066,10 @@ Equivalent to @samp{-march=mips32r2}.
@opindex mips64
Equivalent to @samp{-march=mips64}.
+@item -mips64r2
+@opindex mips64r2
+Equivalent to @samp{-march=mips64r2}.
+
@item -mips16
@itemx -mno-mips16
@opindex mips16
diff --git a/gcc/doc/passes.texi b/gcc/doc/passes.texi
index 4b0c0b6fb7c..daeaf9520e1 100644
--- a/gcc/doc/passes.texi
+++ b/gcc/doc/passes.texi
@@ -166,6 +166,10 @@ not attempt to (re-)generate data structures or lower intermediate
language form based on the requirements of the next pass. Nevertheless,
what is present is useful, and a far sight better than nothing at all.
+Each pass may have its own dump file (for GCC debugging purposes).
+Passes without any names, or with a name starting with a star, do not
+dump anything.
+
TODO: describe the global variables set up by the pass manager,
and a brief description of how a new pass should use it.
I need to look at what info rtl passes use first@enddots{}
@@ -275,7 +279,7 @@ located in @file{tree-ssa.c} and is described by @code{pass_build_ssa}.
This pass scans the function for uses of @code{SSA_NAME}s that
are fed by default definition. For non-parameter variables, such
uses are uninitialized. The pass is run twice, before and after
-optimization. In the first pass we only warn for uses that are
+optimization (if turned on). In the first pass we only warn for uses that are
positively uninitialized; in the second pass we warn for uses that
are possibly uninitialized. The pass is located in @file{tree-ssa.c}
and is defined by @code{pass_early_warn_uninitialized} and
diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c
index 72514a61a27..7e29d2af746 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -387,6 +387,7 @@ static void output_cfi (dw_cfi_ref, dw_fde_ref, int);
static void output_call_frame_info (int);
static void dwarf2out_note_section_used (void);
static void dwarf2out_stack_adjust (rtx, bool);
+static void dwarf2out_args_size_adjust (HOST_WIDE_INT, const char *);
static void flush_queued_reg_saves (void);
static bool clobbers_queued_reg_save (const_rtx);
static void dwarf2out_frame_debug_expr (rtx, const char *);
@@ -1155,6 +1156,162 @@ stack_adjust_offset (const_rtx pattern)
return offset;
}
+/* Precomputed args_size for CODE_LABELs and BARRIERs preceeding them,
+ indexed by INSN_UID. */
+
+static HOST_WIDE_INT *barrier_args_size;
+
+/* Helper function for compute_barrier_args_size. Handle one insn. */
+
+static HOST_WIDE_INT
+compute_barrier_args_size_1 (rtx insn, HOST_WIDE_INT cur_args_size,
+ VEC (rtx, heap) **next)
+{
+ HOST_WIDE_INT offset = 0;
+ int i;
+
+ if (! RTX_FRAME_RELATED_P (insn))
+ {
+ if (prologue_epilogue_contains (insn)
+ || sibcall_epilogue_contains (insn))
+ /* Nothing */;
+ else if (GET_CODE (PATTERN (insn)) == SET)
+ offset = stack_adjust_offset (PATTERN (insn));
+ else if (GET_CODE (PATTERN (insn)) == PARALLEL
+ || GET_CODE (PATTERN (insn)) == SEQUENCE)
+ {
+ /* There may be stack adjustments inside compound insns. Search
+ for them. */
+ for (i = XVECLEN (PATTERN (insn), 0) - 1; i >= 0; i--)
+ if (GET_CODE (XVECEXP (PATTERN (insn), 0, i)) == SET)
+ offset += stack_adjust_offset (XVECEXP (PATTERN (insn), 0, i));
+ }
+ }
+ else
+ {
+ rtx expr = find_reg_note (insn, REG_FRAME_RELATED_EXPR, NULL_RTX);
+
+ if (expr)
+ {
+ expr = XEXP (expr, 0);
+ if (GET_CODE (expr) == PARALLEL
+ || GET_CODE (expr) == SEQUENCE)
+ for (i = 1; i < XVECLEN (expr, 0); i++)
+ {
+ rtx elem = XVECEXP (expr, 0, i);
+
+ if (GET_CODE (elem) == SET && !RTX_FRAME_RELATED_P (elem))
+ offset += stack_adjust_offset (elem);
+ }
+ }
+ }
+
+#ifndef STACK_GROWS_DOWNWARD
+ offset = -offset;
+#endif
+
+ cur_args_size += offset;
+ if (cur_args_size < 0)
+ cur_args_size = 0;
+
+ if (JUMP_P (insn))
+ {
+ rtx dest = JUMP_LABEL (insn);
+
+ if (dest)
+ {
+ if (barrier_args_size [INSN_UID (dest)] < 0)
+ {
+ barrier_args_size [INSN_UID (dest)] = cur_args_size;
+ VEC_safe_push (rtx, heap, *next, dest);
+ }
+ else
+ gcc_assert (barrier_args_size[INSN_UID (dest)]
+ == cur_args_size);
+ }
+ }
+
+ return cur_args_size;
+}
+
+/* Walk the whole function and compute args_size on BARRIERs. */
+
+static void
+compute_barrier_args_size (void)
+{
+ int max_uid = get_max_uid (), i;
+ rtx insn;
+ VEC (rtx, heap) *worklist, *next, *tmp;
+
+ barrier_args_size = XNEWVEC (HOST_WIDE_INT, max_uid);
+ for (i = 0; i < max_uid; i++)
+ barrier_args_size[i] = -1;
+
+ worklist = VEC_alloc (rtx, heap, 20);
+ next = VEC_alloc (rtx, heap, 20);
+ insn = get_insns ();
+ barrier_args_size[INSN_UID (insn)] = 0;
+ VEC_quick_push (rtx, worklist, insn);
+ for (;;)
+ {
+ while (!VEC_empty (rtx, worklist))
+ {
+ rtx prev, body;
+ HOST_WIDE_INT cur_args_size;
+
+ insn = VEC_pop (rtx, worklist);
+ cur_args_size = barrier_args_size[INSN_UID (insn)];
+ prev = prev_nonnote_insn (insn);
+ if (prev && BARRIER_P (prev))
+ barrier_args_size[INSN_UID (prev)] = cur_args_size;
+
+ for (; insn; insn = NEXT_INSN (insn))
+ {
+ if (INSN_DELETED_P (insn) || NOTE_P (insn))
+ continue;
+ if (BARRIER_P (insn))
+ break;
+
+ if (LABEL_P (insn))
+ {
+ gcc_assert (barrier_args_size[INSN_UID (insn)] < 0
+ || barrier_args_size[INSN_UID (insn)]
+ == cur_args_size);
+ continue;
+ }
+
+ body = PATTERN (insn);
+ if (GET_CODE (body) == SEQUENCE)
+ {
+ for (i = 1; i < XVECLEN (body, 0); i++)
+ cur_args_size
+ = compute_barrier_args_size_1 (XVECEXP (body, 0, i),
+ cur_args_size, &next);
+ cur_args_size
+ = compute_barrier_args_size_1 (XVECEXP (body, 0, 0),
+ cur_args_size, &next);
+ }
+ else
+ cur_args_size
+ = compute_barrier_args_size_1 (insn, cur_args_size, &next);
+ }
+ }
+
+ if (VEC_empty (rtx, next))
+ break;
+
+ /* Swap WORKLIST with NEXT and truncate NEXT for next iteration. */
+ tmp = next;
+ next = worklist;
+ worklist = tmp;
+ VEC_truncate (rtx, next, 0);
+ }
+
+ VEC_free (rtx, heap, worklist);
+ VEC_free (rtx, heap, next);
+}
+
+
/* Check INSN to see if it looks like a push or a stack adjustment, and
make a note of it if it does. EH uses this information to find out how
much extra space it needs to pop off the stack. */
@@ -1199,13 +1356,15 @@ dwarf2out_stack_adjust (rtx insn, bool after_p)
}
else if (BARRIER_P (insn))
{
- /* When we see a BARRIER, we know to reset args_size to 0. Usually
- the compiler will have already emitted a stack adjustment, but
- doesn't bother for calls to noreturn functions. */
-#ifdef STACK_GROWS_DOWNWARD
- offset = -args_size;
-#else
- offset = args_size;
+ if (barrier_args_size == NULL)
+ compute_barrier_args_size ();
+ offset = barrier_args_size[INSN_UID (insn)];
+ if (offset < 0)
+ offset = 0;
+
+ offset -= args_size;
+#ifndef STACK_GROWS_DOWNWARD
+ offset = -offset;
#endif
}
else if (GET_CODE (PATTERN (insn)) == SET)
@@ -1225,9 +1384,21 @@ dwarf2out_stack_adjust (rtx insn, bool after_p)
if (offset == 0)
return;
+ label = dwarf2out_cfi_label ();
+ dwarf2out_args_size_adjust (offset, label);
+}
+
+/* Adjust args_size based on stack adjustment OFFSET. */
+
+static void
+dwarf2out_args_size_adjust (HOST_WIDE_INT offset, const char *label)
+{
if (cfa.reg == STACK_POINTER_REGNUM)
cfa.offset += offset;
+ if (cfa_store.reg == STACK_POINTER_REGNUM)
+ cfa_store.offset += offset;
+
#ifndef STACK_GROWS_DOWNWARD
offset = -offset;
#endif
@@ -1236,7 +1407,6 @@ dwarf2out_stack_adjust (rtx insn, bool after_p)
if (args_size < 0)
args_size = 0;
- label = dwarf2out_cfi_label ();
def_cfa_1 (label, &cfa);
if (flag_asynchronous_unwind_tables)
dwarf2out_args_size (label, args_size);
@@ -1668,22 +1838,7 @@ dwarf2out_frame_debug_expr (rtx expr, const char *label)
HOST_WIDE_INT offset = stack_adjust_offset (elem);
if (offset != 0)
- {
- if (cfa.reg == STACK_POINTER_REGNUM)
- cfa.offset += offset;
-
-#ifndef STACK_GROWS_DOWNWARD
- offset = -offset;
-#endif
-
- args_size += offset;
- if (args_size < 0)
- args_size = 0;
-
- def_cfa_1 (label, &cfa);
- if (flag_asynchronous_unwind_tables)
- dwarf2out_args_size (label, args_size);
- }
+ dwarf2out_args_size_adjust (offset, label);
}
}
return;
@@ -2027,6 +2182,13 @@ dwarf2out_frame_debug_expr (rtx expr, const char *label)
gcc_unreachable ();
}
+ /* Rule 17 */
+ /* If the source operand of this MEM operation is not a
+ register, basically the source is return address. Here
+ we only care how much stack grew and we don't save it. */
+ if (!REG_P (src))
+ break;
+
if (REGNO (src) != STACK_POINTER_REGNUM
&& REGNO (src) != HARD_FRAME_POINTER_REGNUM
&& (unsigned) REGNO (src) == cfa.reg)
@@ -2085,12 +2247,6 @@ dwarf2out_frame_debug_expr (rtx expr, const char *label)
break;
}
}
- /* Rule 17 */
- /* If the source operand of this MEM operation is not a
- register, basically the source is return address. Here
- we only care how much stack grew and we don't save it. */
- if (!REG_P (src))
- break;
def_cfa_1 (label, &cfa);
{
@@ -2162,6 +2318,12 @@ dwarf2out_frame_debug (rtx insn, bool after_p)
regs_saved_in_regs[i].saved_in_reg = NULL_RTX;
}
num_regs_saved_in_regs = 0;
+
+ if (barrier_args_size)
+ {
+ XDELETEVEC (barrier_args_size);
+ barrier_args_size = NULL;
+ }
return;
}
@@ -8846,7 +9008,8 @@ is_subrange_type (const_tree type)
return false;
if (TREE_CODE (subtype) != INTEGER_TYPE
- && TREE_CODE (subtype) != ENUMERAL_TYPE)
+ && TREE_CODE (subtype) != ENUMERAL_TYPE
+ && TREE_CODE (subtype) != BOOLEAN_TYPE)
return false;
if (TREE_CODE (type) == TREE_CODE (subtype)
@@ -9290,8 +9453,7 @@ based_loc_descr (rtx reg, HOST_WIDE_INT offset,
pointer + offset to access stack variables. If stack
is aligned without drap, use stack pointer + offset to
access stack variables. */
- if (fde
- && fde->stack_realign
+ if (crtl->stack_realign_tried
&& cfa.reg == HARD_FRAME_POINTER_REGNUM
&& reg == frame_pointer_rtx)
{
@@ -14067,6 +14229,22 @@ is_redundant_typedef (const_tree decl)
return 0;
}
+/* Returns the DIE for a context. */
+
+static inline dw_die_ref
+get_context_die (tree context)
+{
+ if (context)
+ {
+ /* Find die that represents this context. */
+ if (TYPE_P (context))
+ return force_type_die (context);
+ else
+ return force_decl_die (context);
+ }
+ return comp_unit_die;
+}
+
/* Returns the DIE for decl. A DIE will always be returned. */
static dw_die_ref
@@ -14078,18 +14256,7 @@ force_decl_die (tree decl)
decl_die = lookup_decl_die (decl);
if (!decl_die)
{
- dw_die_ref context_die;
- tree decl_context = DECL_CONTEXT (decl);
- if (decl_context)
- {
- /* Find die that represents this context. */
- if (TYPE_P (decl_context))
- context_die = force_type_die (decl_context);
- else
- context_die = force_decl_die (decl_context);
- }
- else
- context_die = comp_unit_die;
+ dw_die_ref context_die = get_context_die (DECL_CONTEXT (decl));
decl_die = lookup_decl_die (decl);
if (decl_die)
@@ -14144,16 +14311,7 @@ force_type_die (tree type)
type_die = lookup_type_die (type);
if (!type_die)
{
- dw_die_ref context_die;
- if (TYPE_CONTEXT (type))
- {
- if (TYPE_P (TYPE_CONTEXT (type)))
- context_die = force_type_die (TYPE_CONTEXT (type));
- else
- context_die = force_decl_die (TYPE_CONTEXT (type));
- }
- else
- context_die = comp_unit_die;
+ dw_die_ref context_die = get_context_die (TYPE_CONTEXT (type));
type_die = modified_type_die (type, TYPE_READONLY (type),
TYPE_VOLATILE (type), context_die);
@@ -14475,16 +14633,11 @@ dwarf2out_imported_module_or_decl (tree decl, tree context)
/* Get the scope die for decl context. Use comp_unit_die for global module
or decl. If die is not found for non globals, force new die. */
- if (!context)
- scope_die = comp_unit_die;
- else if (TYPE_P (context))
- {
- if (!should_emit_struct_debug (context, DINFO_USAGE_DIR_USE))
- return;
- scope_die = force_type_die (context);
- }
- else
- scope_die = force_decl_die (context);
+ if (context
+ && TYPE_P (context)
+ && !should_emit_struct_debug (context, DINFO_USAGE_DIR_USE))
+ return;
+ scope_die = get_context_die (context);
/* For TYPE_DECL or CONST_DECL, lookup TREE_TYPE. */
if (TREE_CODE (decl) == TYPE_DECL || TREE_CODE (decl) == CONST_DECL)
@@ -14493,6 +14646,16 @@ dwarf2out_imported_module_or_decl (tree decl, tree context)
at_import_die = base_type_die (TREE_TYPE (decl));
else
at_import_die = force_type_die (TREE_TYPE (decl));
+ /* For namespace N { typedef void T; } using N::T; base_type_die
+ returns NULL, but DW_TAG_imported_declaration requires
+ the DW_AT_import tag. Force creation of DW_TAG_typedef. */
+ if (!at_import_die)
+ {
+ gcc_assert (TREE_CODE (decl) == TYPE_DECL);
+ gen_typedef_die (decl, get_context_die (DECL_CONTEXT (decl)));
+ at_import_die = lookup_type_die (TREE_TYPE (decl));
+ gcc_assert (at_import_die);
+ }
}
else
{
@@ -14504,21 +14667,14 @@ dwarf2out_imported_module_or_decl (tree decl, tree context)
if (TREE_CODE (decl) == FIELD_DECL)
{
tree type = DECL_CONTEXT (decl);
- dw_die_ref type_context_die;
- if (TYPE_CONTEXT (type))
- if (TYPE_P (TYPE_CONTEXT (type)))
- {
- if (!should_emit_struct_debug (TYPE_CONTEXT (type),
- DINFO_USAGE_DIR_USE))
- return;
- type_context_die = force_type_die (TYPE_CONTEXT (type));
- }
- else
- type_context_die = force_decl_die (TYPE_CONTEXT (type));
- else
- type_context_die = comp_unit_die;
- gen_type_die_for_member (type, decl, type_context_die);
+ if (TYPE_CONTEXT (type)
+ && TYPE_P (TYPE_CONTEXT (type))
+ && !should_emit_struct_debug (TYPE_CONTEXT (type),
+ DINFO_USAGE_DIR_USE))
+ return;
+ gen_type_die_for_member (type, decl,
+ get_context_die (TYPE_CONTEXT (type)));
}
at_import_die = force_decl_die (decl);
}
diff --git a/gcc/expr.c b/gcc/expr.c
index 4984780fe32..eae8093d61e 100644
--- a/gcc/expr.c
+++ b/gcc/expr.c
@@ -4280,6 +4280,7 @@ expand_assignment (tree to, tree from, bool nontemporal)
needs to be done. Handling this in the normal way is safe because no
computation is done before the call. */
if (TREE_CODE (from) == CALL_EXPR && ! aggregate_value_p (from, from)
+ && COMPLETE_TYPE_P (TREE_TYPE (from))
&& TREE_CODE (TYPE_SIZE (TREE_TYPE (from))) == INTEGER_CST
&& ! ((TREE_CODE (to) == VAR_DECL || TREE_CODE (to) == PARM_DECL)
&& REG_P (DECL_RTL (to))))
diff --git a/gcc/final.c b/gcc/final.c
index 6fb1214726a..8456dad9acb 100644
--- a/gcc/final.c
+++ b/gcc/final.c
@@ -1758,6 +1758,9 @@ call_from_call_insn (rtx insn)
{
default:
gcc_unreachable ();
+ case COND_EXEC:
+ x = COND_EXEC_CODE (x);
+ break;
case PARALLEL:
x = XVECEXP (x, 0, 0);
break;
diff --git a/gcc/function.c b/gcc/function.c
index b9d9ec59cc0..637775160eb 100644
--- a/gcc/function.c
+++ b/gcc/function.c
@@ -1215,10 +1215,10 @@ instantiate_new_reg (rtx x, HOST_WIDE_INT *poffset)
if (x == virtual_incoming_args_rtx)
{
- /* Replace virtual_incoming_args_rtx to internal arg pointer here */
- if (crtl->args.internal_arg_pointer != virtual_incoming_args_rtx)
+ if (stack_realign_drap)
{
- gcc_assert (stack_realign_drap);
+ /* Replace virtual_incoming_args_rtx with internal arg
+ pointer if DRAP is used to realign stack. */
new = crtl->args.internal_arg_pointer;
offset = 0;
}
diff --git a/gcc/function.h b/gcc/function.h
index ebba29f3862..1153fb0b4c4 100644
--- a/gcc/function.h
+++ b/gcc/function.h
@@ -417,20 +417,25 @@ struct rtl_data GTY(())
/* When set, expand should optimize for speed. */
bool maybe_hot_insn_p;
- /* Nonzero if function stack realignment is needed. This flag may be
- set twice: before and after reload. It is set before reload wrt
- stack alignment estimation before reload. It will be changed after
- reload if by then criteria of stack realignment is different.
+ /* Nonzero if function stack realignment is needed. This flag may be
+ set twice: before and after reload. It is set before reload wrt
+ stack alignment estimation before reload. It will be changed after
+ reload if by then criteria of stack realignment is different.
The value set after reload is the accurate one and is finalized. */
bool stack_realign_needed;
+ /* Nonzero if function stack realignment is tried. This flag is set
+ only once before reload. It affects register elimination. This
+ is used to generate DWARF debug info for stack variables. */
+ bool stack_realign_tried;
+
/* Nonzero if function being compiled needs dynamic realigned
argument pointer (drap) if stack needs realigning. */
bool need_drap;
/* Nonzero if function stack realignment estimation is done, namely
- stack_realign_needed flag has been set before reload wrt
- estimated stack alignment info. */
+ stack_realign_needed flag has been set before reload wrt estimated
+ stack alignment info. */
bool stack_realign_processed;
/* Nonzero if function stack realignment has been finalized, namely
diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index 0f5605abf81..e7fc1679aa3 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -2465,7 +2465,7 @@ gimplify_call_expr (tree *expr_p, gimple_seq *pre_p, bool want_value)
}
else
{
- *expr_p = NULL_TREE;
+ *expr_p = error_mark_node;
return GS_ERROR;
}
diff --git a/gcc/libada-mk.in b/gcc/libada-mk.in
deleted file mode 100644
index 2b795d6a693..00000000000
--- a/gcc/libada-mk.in
+++ /dev/null
@@ -1,29 +0,0 @@
-# Copyright 2004, 2007 Free Software Foundation, Inc.
-
-#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 3, or (at your option)
-#any later version.
-
-#GCC is distributed in the hope that it will be useful,
-#but WITHOUT ANY WARRANTY; without even the implied warranty of
-#MERCHANTABILITY or 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 COPYING3. If not see
-#<http://www.gnu.org/licenses/>.
-
-# GCC's Makefile fragment for libada.
-# libada needs some information from the GCC configure file at the moment,
-# and this exists to transfer that information in as clean a way as possible.
-
-exeext=@host_exeext@
-libdir=@libdir@
-NOCOMMON_FLAG=@nocommon_flag@
-WARN_CFLAGS=@warn_cflags@
-gcc_tmake_file=@tmake_file@
-gcc_xmake_file=@xmake_file@
-host_cc_for_libada=@host_cc_for_libada@
diff --git a/gcc/opts.c b/gcc/opts.c
index 13a7de1709f..54512513f42 100644
--- a/gcc/opts.c
+++ b/gcc/opts.c
@@ -1080,13 +1080,6 @@ decode_options (unsigned int argc, const char **argv)
so force it not to be done. */
warn_inline = 0;
flag_no_inline = 1;
-
- /* The c_decode_option function and decode_option hook set
- this to `2' if -Wall is used, so we can avoid giving out
- lots of errors for people who don't realize what -Wall does. */
- if (warn_uninitialized == 1)
- warning (OPT_Wuninitialized,
- "-Wuninitialized is not supported without -O");
}
/* The optimization to partition hot and cold basic blocks into separate
diff --git a/gcc/passes.c b/gcc/passes.c
index d07a5ca9f3d..400717f79b7 100644
--- a/gcc/passes.c
+++ b/gcc/passes.c
@@ -406,7 +406,7 @@ register_dump_files_1 (struct opt_pass *pass, int properties)
int new_properties = (properties | pass->properties_provided)
& ~pass->properties_destroyed;
- if (pass->name)
+ if (pass->name && pass->name[0] != '*')
register_one_dump_file (pass);
if (pass->sub)
@@ -544,10 +544,10 @@ init_optimization_passes (void)
NEXT_PASS (pass_referenced_vars);
NEXT_PASS (pass_reset_cc_flags);
NEXT_PASS (pass_build_ssa);
+ NEXT_PASS (pass_early_warn_uninitialized);
NEXT_PASS (pass_all_early_optimizations);
{
struct opt_pass **p = &pass_all_early_optimizations.pass.sub;
- NEXT_PASS (pass_early_warn_uninitialized);
NEXT_PASS (pass_rebuild_cgraph_edges);
NEXT_PASS (pass_early_inline);
NEXT_PASS (pass_cleanup_cfg);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ab4b945f30d..8d9618f9341 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,133 @@
+2008-08-01 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gnat.dg/boolean_expr.ad[sb]: Rename to boolean_expr1.ad[sb].
+
+2008-08-01 Richard Guenther <rguenther@suse.de>
+
+ PR middle-end/36997
+ * gcc.dg/pr36997.c: New testcase.
+
+2008-08-01 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gnat.dg/deferred_const1.adb: New test.
+ * gnat.dg/deferred_const2.adb: Likewise.
+ * gnat.dg/deferred_const2_pkg.ad[sb]: New helper.
+ * gnat.dg/deferred_const3.adb: New test.
+ * gnat.dg/deferred_const3_pkg.ad[sb]: New helper.
+
+2008-08-01 Richard Guenther <rguenther@suse.de>
+
+ PR tree-optimization/36988
+ * gcc.c-torture/compile/pr36988.c: New testcase.
+
+2008-08-01 Olivier Hainque <hainque@adacore.com>
+
+ * gnat.dg/raise_from_pure.ad[bs],
+ * gnat.dg/wrap_raise_from_pure.ad[bs]: Support for ...
+ * gnat.dg/test_raise_from_pure.adb: New test.
+
+2008-07-31 Adam Nemet <anemet@caviumnetworks.com>
+
+ * gcc.target/mips/ext-1.c: New test.
+
+2008-07-31 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gnat.dg/discr10.ad[sb]: New test.
+
+2008-07-31 Jakub Jelinek <jakub@redhat.com>
+
+ PR target/35100
+ * gcc.target/powerpc/longcall-1.c: New test.
+
+ PR preprocessor/36649
+ * gcc.dg/pch/cpp-3.hs: Add include guards.
+ * gcc.dg/pch/cpp-3a.h: Likewise.
+ * gcc.dg/pch/cpp-3b.h: Likewise.
+ * gcc.dg/cpp/mi8.c: New test.
+ * gcc.dg/cpp/mi8a.h: New file.
+ * gcc.dg/cpp/mi8b.h: New file.
+ * gcc.dg/cpp/mi8c.h: New file.
+ * gcc.dg/cpp/mi8d.h: New file.
+
+ PR rtl-optimization/36419
+ * g++.dg/eh/async-unwind2.C: New test.
+
+ PR c++/36405
+ * g++.dg/rtti/typeid8.C: New test.
+
+2008-07-31 Richard Guenther <rguenther@suse.de>
+
+ PR tree-optimization/36978
+ * gcc.dg/torture/pr36978.c: New testcase.
+
+2008-07-31 Arnaud Charlet <charlet@adacore.com>
+
+ * gnat.dg/sync_iface_test.ad[s,b]: New test.
+
+ * gnat.dg/specs/sync_iface_test.ads: New test.
+ * gnat.dg/specs/null_aggr_bug.ads: New test.
+
+2008-07-31 H.J. Lu <hongjiu.lu@intel.com>
+
+ * gcc.dg/torture/stackalign/pr16660-1.c: Include "check.h".
+ (f): Align to 64 byte. Use check instead of asm statement.
+
+2008-07-31 Arnaud Charlet <charlet@adacore.com>
+
+ * gnat.dg/missing_acc_check.adb: New test.
+
+2008-07-31 Richard Guenther <rguenther@suse.de>
+
+ * gcc.dg/uninit-1-O0.c: New testcase.
+ * gcc.dg/uninit-2-O0.c: Likewise.
+ * gcc.dg/uninit-3-O0.c: Likewise.
+ * gcc.dg/uninit-4-O0.c: Likewise.
+ * gcc.dg/uninit-5-O0.c: Likewise.
+ * gcc.dg/uninit-6-O0.c: Likewise.
+ * gcc.dg/uninit-8-O0.c: Likewise.
+ * gcc.dg/uninit-9-O0.c: Likewise.
+ * gcc.dg/uninit-A-O0.c: Likewise.
+ * gcc.dg/uninit-B-O0.c: Likewise.
+ * gcc.dg/uninit-C-O0.c: Likewise.
+ * gcc.dg/uninit-D-O0.c: Likewise.
+ * gcc.dg/uninit-E-O0.c: Likewise.
+ * gcc.dg/uninit-F-O0.c: Likewise.
+ * gcc.dg/uninit-G-O0.c: Likewise.
+ * gcc.dg/uninit-H-O0.c: Likewise.
+ * gcc.dg/uninit-I-O0.c: Likewise.
+ * gcc.dg/uninit-10-O0.c: Likewise.
+ * gcc.dg/uninit-11-O0.c: Likewise.
+ * gcc.dg/uninit-12-O0.c: Likewise.
+ * gcc.dg/uninit-13-O0.c: Likewise.
+ * gcc.dg/uninit-14-O0.c: Likewise.
+ * gcc.dg/uninit-15-O0.c: Likewise.
+ * gcc.dg/Wall.c: Avoid uninitialized warning.
+ * gcc.dg/Wno-all.c: Likewise.
+ * gcc.dg/pr3074-1.c: Likewise.
+
+2008-07-31 Arnaud Charlet <charlet@adacore.com>
+
+ * gnat.dg/specs/genericppc.ads: New test.
+
+2008-07-31 Jakub Jelinek <jakub@redhat.com>
+
+ PR c/36970
+ * gcc.dg/free-1.c: New test.
+ * gcc.dg/free-2.c: New test.
+
+ PR debug/36278
+ * g++.dg/debug/namespace2.C: New test.
+
+ PR preprocessor/36649
+ * gcc.dg/pch/cpp-3.c: New test.
+ * gcc.dg/pch/cpp-3.hs: New file.
+ * gcc.dg/pch/cpp-3a.h: New file.
+ * gcc.dg/pch/cpp-3b.h: New file.
+
+2008-07-30 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gnat.dg/boolean_expr.ad[sb]: New test.
+
2008-07-30 H.J. Lu <hongjiu.lu@intel.com>
Joey Ye <joey.ye@intel.com>
@@ -3666,7 +3796,7 @@
PR fortran/35780
* gfortran.dg/simplify_argN_1.f90: New test.
-2008-04-06 Tobias Schlüter <tobi@gcc.gnu.org>
+2008-04-06 Tobias Schl�ter <tobi@gcc.gnu.org>
PR fortran/35832
* gfortran.dg/io_constraints_2.f90: Adapt to new error message.
diff --git a/gcc/testsuite/g++.dg/debug/namespace2.C b/gcc/testsuite/g++.dg/debug/namespace2.C
new file mode 100644
index 00000000000..f70bc8fada8
--- /dev/null
+++ b/gcc/testsuite/g++.dg/debug/namespace2.C
@@ -0,0 +1,8 @@
+// PR debug/36278
+// { dg-do compile }
+
+namespace N
+{
+ typedef void T;
+}
+using N::T;
diff --git a/gcc/testsuite/g++.dg/eh/async-unwind2.C b/gcc/testsuite/g++.dg/eh/async-unwind2.C
new file mode 100644
index 00000000000..694fad6aca1
--- /dev/null
+++ b/gcc/testsuite/g++.dg/eh/async-unwind2.C
@@ -0,0 +1,254 @@
+// PR rtl-optimization/36419
+// { dg-do run { target { { i?86-*-* x86_64-*-* } && ilp32 } } }
+// { dg-options "-Os -fasynchronous-unwind-tables -fpic -fno-inline" }
+
+#include <stdarg.h>
+
+extern "C" void abort ();
+
+extern "C"
+{
+ struct R { int r1; unsigned short r2[1]; };
+ int bar1 (unsigned short *, int, short) throw ();
+ void bar2 (R *) throw ();
+ void bar3 (R **, const unsigned short *, int) throw ();
+ void bar4 (R **, const char *) throw ();
+ void bar5 (void *, const char *, ...);
+}
+
+struct S
+{
+ R *s;
+ struct T { };
+ S (R *x, T *) { s = x; }
+ ~S () { bar2 (s); }
+ S &operator= (const S &x);
+ S &operator+= (const S &x);
+ S sfn1 (const S &x) const;
+ friend S operator+ (const S &x1, const S &x2);
+ static S sfn2 (int i)
+ {
+ unsigned short q[33];
+ R *p = 0;
+ bar3 (&p, q, bar1 (q, i, 10));
+ return S (p, (T *) 0);
+ }
+ static S sfn3 (const char *x)
+ {
+ R *p = 0;
+ bar4 (&p, x);
+ return S (p, (T *) 0);
+ }
+};
+
+struct U { };
+template <class C> unsigned char operator >>= (const U &, C &);
+
+struct V;
+struct W
+{
+ V *w;
+ unsigned char is () const;
+};
+
+template <class T> struct X : public W
+{
+ inline ~X ();
+ X ();
+ X (const W &);
+ T *operator -> () const;
+};
+
+struct E
+{
+ E ();
+ E (const S &, const X <V> &);
+ E (E const &);
+ ~E ();
+ E &operator = (E const &);
+};
+
+struct V
+{
+ virtual void release () throw ();
+};
+
+template <class T> X <T>::~X ()
+{
+ if (w)
+ w->release ();
+}
+
+struct Y
+{
+ virtual U yfn1 (const S &);
+};
+
+struct Z;
+
+X <V> baz1 (const S &) throw (E);
+X <Z> baz2 (const X <Z> &) throw (E);
+
+template <typename T> X<T>::X ()
+{
+ w = __null;
+}
+
+template <typename T> X<T>::X (W const &)
+{
+ w = __null;
+}
+
+U Y::yfn1 (const S &)
+{
+ throw 12;
+}
+
+Y y;
+
+template <typename T> T *X<T>::operator -> () const
+{
+ return &y;
+}
+
+X <V> baz1 (const S &) throw (E)
+{
+ return X<V> ();
+}
+
+E::E ()
+{
+}
+
+E::~E ()
+{
+}
+
+X <Z> baz2 (const X <Z> &) throw (E)
+{
+ throw E ();
+}
+
+int bar1 (unsigned short *, int, short) throw ()
+{
+ asm volatile ("" : : : "memory");
+ return 0;
+}
+
+void bar2 (R *) throw ()
+{
+ asm volatile ("" : : : "memory");
+}
+
+void bar3 (R **, const unsigned short *, int) throw ()
+{
+ asm volatile ("" : : : "memory");
+}
+
+void bar4 (R **, const char *) throw ()
+{
+ asm volatile ("" : : : "memory");
+}
+
+int events[2];
+void *sp;
+
+void bar5 (void *p, const char *s, ...)
+{
+ va_list ap;
+ va_start (ap, s);
+ if (p)
+ throw 19;
+ switch (*s)
+ {
+ case 't':
+ if (events[0] != va_arg (ap, int))
+ abort ();
+ events[0]++;
+ break;
+ case 'f':
+ abort ();
+ case 'c':
+ if (events[1] != va_arg (ap, int))
+ abort ();
+ events[1]++;
+ if (events[1] == 1)
+ sp = va_arg (ap, void *);
+ else if (sp != va_arg (ap, void *))
+ abort ();
+ break;
+ }
+}
+
+unsigned char W::is () const
+{
+ return 1;
+}
+
+S &S::operator += (const S &)
+{
+ return *this;
+}
+
+template <class C> unsigned char operator >>= (const U &, C &)
+{
+ throw 1;
+}
+
+template X<Y>::X ();
+template X<Z>::X ();
+template unsigned char operator >>= (const U &, X<Z> &);
+template X<Y>::X (W const &);
+
+template Y *X<Y>::operator-> () const;
+
+X <Z> foo () throw ()
+{
+ X <Z> a;
+ X <Y> b;
+ try
+ {
+ b = X <Y> (baz1 (S::sfn3 ("defg")));
+ }
+ catch (E &)
+ {
+ }
+ if (b.is ())
+ {
+ for (int n = 0; n < 10; n++)
+ {
+ S c = S::sfn3 ("abcd");
+ c += S::sfn2 (n);
+ X <Z> d;
+ try
+ {
+ bar5 ((void *) 0, "trying %d\n", n);
+ if ((b->yfn1 (c) >>= d))
+ if (d.is ())
+ {
+ bar5 ((void *) 0, "failure1 on %d\n", n);
+ a = baz2 (d);
+ if (a.is ())
+ break;
+ }
+ bar5 ((void *) 0, "failure2 on %d\n", n);
+ }
+ catch (...)
+ {
+ void *p;
+ asm volatile ("movl %%esp, %0" : "=r" (p));
+ bar5 ((void *) 0, "caught %d %p\n", n, p);
+ }
+ }
+ }
+ return a;
+}
+
+int
+main ()
+{
+ foo ();
+ if (events[0] != 10 || events[1] != 10)
+ abort ();
+ return 0;
+}
diff --git a/gcc/testsuite/g++.dg/expr/anew4.C b/gcc/testsuite/g++.dg/expr/anew4.C
index d86d5251412..4ce1d8899f9 100644
--- a/gcc/testsuite/g++.dg/expr/anew4.C
+++ b/gcc/testsuite/g++.dg/expr/anew4.C
@@ -1,5 +1,4 @@
-// { dg-do run { xfail *-*-* } }
-// XFAILed until PR2123 is fixed
+// { dg-do run }
// PR 11228: array operator new, with zero-initialization and a variable sized array.
// Regression test for PR
// Author: Matt Austern <austern@apple.com>
diff --git a/gcc/testsuite/g++.dg/init/value3.C b/gcc/testsuite/g++.dg/init/value3.C
new file mode 100644
index 00000000000..487baabeceb
--- /dev/null
+++ b/gcc/testsuite/g++.dg/init/value3.C
@@ -0,0 +1,31 @@
+// Testcase for value-initialization in new-expressions.
+// { dg-do run }
+
+#include <stdlib.h>
+#include <string.h>
+
+// Make sure that we return memory that isn't already set to 0.
+void *operator new(size_t s)
+{
+ void *p = malloc (s);
+ memset (p, 42, s);
+ return p;
+}
+
+struct A { A() {} ~A() {} };
+struct B { A a; int i; };
+
+int main()
+{
+ B *p = new B();
+ if (p->i != 0)
+ abort();
+
+ p = new B[2]();
+ if (p[0].i != 0 || p[1].i != 0)
+ abort();
+
+ B(*p2)[2] = new B[2][2]();
+ if (p2[0][0].i != 0 || p2[0][1].i != 0)
+ abort();
+}
diff --git a/gcc/testsuite/g++.dg/lookup/new1.C b/gcc/testsuite/g++.dg/lookup/new1.C
index b9d0bef88f6..ae1121339cf 100644
--- a/gcc/testsuite/g++.dg/lookup/new1.C
+++ b/gcc/testsuite/g++.dg/lookup/new1.C
@@ -4,10 +4,10 @@
int main() {
int i;
- void* operator new(unsigned s, int* p);
+ void* operator new(__SIZE_TYPE__ s, int* p);
int* e = new(&i) int; // { dg-error "no matching function" }
int* f = new int;
return 0;
}
-// { dg-excess-errors "operator new" }
+// { dg-error "candidate" "" { target *-*-* } 0 }
diff --git a/gcc/testsuite/g++.dg/rtti/typeid8.C b/gcc/testsuite/g++.dg/rtti/typeid8.C
new file mode 100644
index 00000000000..2b13be5ef52
--- /dev/null
+++ b/gcc/testsuite/g++.dg/rtti/typeid8.C
@@ -0,0 +1,26 @@
+// PR c++/36405
+// { dg-do compile }
+
+#include <typeinfo>
+
+struct A
+{
+ void foo ()
+ {
+ typeid (foo).name (); // { dg-error "invalid use of member" }
+ typeid (A::foo).name (); // { dg-error "invalid use of member" }
+ }
+ void bar ()
+ {
+ typeid (foo).name (); // { dg-error "invalid use of member" }
+ typeid (A::foo).name (); // { dg-error "invalid use of member" }
+ }
+ static void baz ()
+ {
+ typeid (baz).name ();
+ typeid (A::baz).name ();
+ }
+};
+
+const char *p1 = typeid (A::foo).name (); // { dg-error "invalid use of non-static member" }
+const char *p2 = typeid (A::baz).name ();
diff --git a/gcc/testsuite/g++.dg/tree-ssa/new1.C b/gcc/testsuite/g++.dg/tree-ssa/new1.C
new file mode 100644
index 00000000000..a859f0ac377
--- /dev/null
+++ b/gcc/testsuite/g++.dg/tree-ssa/new1.C
@@ -0,0 +1,42 @@
+// PR c++/36633
+
+/* { dg-do compile } */
+/* { dg-options "-O2 -Wall -fdump-tree-forwprop1" } */
+// No particular reason for choosing forwprop1 dump to look at.
+
+struct B { ~B() {} };
+struct D : public B {};
+//struct D {};
+
+struct my_deleter
+{
+ void operator()(D * d)
+ {
+ // delete [] d;
+ }
+};
+
+struct smart_ptr
+{
+ smart_ptr(D * ptr) : p(ptr) { }
+ ~smart_ptr() { d(p); }
+ D * p;
+ my_deleter d;
+};
+
+int
+test01()
+{
+ smart_ptr p(new D[7]);
+
+ return 0;
+}
+
+int main()
+{
+ test01();
+ return 0;
+}
+
+/* { dg-final { scan-tree-dump-not "= .* \\+ -" "forwprop1" } } */
+/* { dg-final { cleanup-tree-dump "forwprop1" } } */
diff --git a/gcc/testsuite/g++.dg/tree-ssa/pr31146-2.C b/gcc/testsuite/g++.dg/tree-ssa/pr31146-2.C
index 0fd60275b53..d2edb1953a3 100644
--- a/gcc/testsuite/g++.dg/tree-ssa/pr31146-2.C
+++ b/gcc/testsuite/g++.dg/tree-ssa/pr31146-2.C
@@ -20,5 +20,5 @@ double foo (void)
return v.a[2];
}
-/* { dg-final { scan-tree-dump "Replaced .*iftmp.* != 0B. with .1" "forwprop1" } } */
+/* { dg-final { scan-tree-dump "Replaced .* != 0B. with .1" "forwprop1" } } */
/* { dg-final { cleanup-tree-dump "forwprop1" } } */
diff --git a/gcc/testsuite/gcc.c-torture/compile/pr36988.c b/gcc/testsuite/gcc.c-torture/compile/pr36988.c
new file mode 100644
index 00000000000..44118d5dda3
--- /dev/null
+++ b/gcc/testsuite/gcc.c-torture/compile/pr36988.c
@@ -0,0 +1,11 @@
+typedef struct {
+ unsigned char mbxCommand;
+} MAILBOX_t;
+void lpfc_sli_brdrestart(void)
+{
+ volatile unsigned int word0;
+ MAILBOX_t *mb;
+ mb = (MAILBOX_t *) &word0;
+ mb->mbxCommand = 0x1A;
+ __writel((*(unsigned int *) mb));
+}
diff --git a/gcc/testsuite/gcc.dg/Wall.c b/gcc/testsuite/gcc.dg/Wall.c
index 86a359b49cd..89848471780 100644
--- a/gcc/testsuite/gcc.dg/Wall.c
+++ b/gcc/testsuite/gcc.dg/Wall.c
@@ -3,8 +3,7 @@
/* { dg-do compile } */
/* { dg-options "-Wall" } */
-void foo()
+void foo(int a)
{
- int a;
5 * (a == 1) | (a == 2); /* { dg-warning "no effect" "no effect" } */
}
diff --git a/gcc/testsuite/gcc.dg/Wno-all.c b/gcc/testsuite/gcc.dg/Wno-all.c
index 3275eb6cd50..de55bbcdacb 100644
--- a/gcc/testsuite/gcc.dg/Wno-all.c
+++ b/gcc/testsuite/gcc.dg/Wno-all.c
@@ -3,9 +3,8 @@
/* { dg-do compile } */
/* { dg-options "-Wall -Wno-all" } */
-void foo()
+void foo(int a)
{
- int a;
5 * (a == 1) | (a == 2); /* { dg-bogus "no effect" "no effect" } */
}
diff --git a/gcc/testsuite/gcc.dg/cpp/mi8.c b/gcc/testsuite/gcc.dg/cpp/mi8.c
new file mode 100644
index 00000000000..1999918dea4
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/cpp/mi8.c
@@ -0,0 +1,8 @@
+/* Test multiple include guards suggestions. */
+
+/* { dg-do preprocess }
+ { dg-options "-H" }
+ { dg-message "mi8a\.h\n\[^\n\]*mi8c\.h\n\[^\n\]*mi8b\.h\n\[^\n\]*mi8d\.h\nMultiple include guards may be useful for:\n\[^\n\]*mi8a\.h\n\[^\n\]*mi8d\.h\n" "" { target *-*-* } 0 } */
+
+#include "mi8a.h"
+#include "mi8b.h"
diff --git a/gcc/testsuite/gcc.dg/cpp/mi8a.h b/gcc/testsuite/gcc.dg/cpp/mi8a.h
new file mode 100644
index 00000000000..893d9ff13b4
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/cpp/mi8a.h
@@ -0,0 +1 @@
+#include "mi8c.h"
diff --git a/gcc/testsuite/gcc.dg/cpp/mi8b.h b/gcc/testsuite/gcc.dg/cpp/mi8b.h
new file mode 100644
index 00000000000..8e3482ce74b
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/cpp/mi8b.h
@@ -0,0 +1,4 @@
+#ifndef GUARDB
+#define GUARDB
+#include "mi8d.h"
+#endif
diff --git a/gcc/testsuite/gcc.dg/cpp/mi8c.h b/gcc/testsuite/gcc.dg/cpp/mi8c.h
new file mode 100644
index 00000000000..08c5cab94ed
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/cpp/mi8c.h
@@ -0,0 +1,4 @@
+#ifndef GUARDC
+#define GUARDC
+/* Empty */
+#endif
diff --git a/gcc/testsuite/gcc.dg/cpp/mi8d.h b/gcc/testsuite/gcc.dg/cpp/mi8d.h
new file mode 100644
index 00000000000..710cecca972
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/cpp/mi8d.h
@@ -0,0 +1 @@
+/* Empty */
diff --git a/gcc/testsuite/gcc.dg/free-1.c b/gcc/testsuite/gcc.dg/free-1.c
new file mode 100644
index 00000000000..5496c84fdb8
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/free-1.c
@@ -0,0 +1,26 @@
+/* PR c/36970 */
+/* { dg-do compile } */
+/* { dg-options "-O2" } */
+
+extern void free (void *);
+
+char *p, buf3[10], d;
+struct S { char a; int b; } *r;
+
+void foo (void)
+{
+ char buf[10], buf2[10], c;
+ static char buf4[10], e;
+ char *q = buf;
+ free (p);
+ free (q); /* { dg-warning "attempt to free a non-heap object" } */
+ free (buf2); /* { dg-warning "attempt to free a non-heap object" } */
+ free (&c); /* { dg-warning "attempt to free a non-heap object" } */
+ free (buf3); /* { dg-warning "attempt to free a non-heap object" } */
+ free (&d); /* { dg-warning "attempt to free a non-heap object" } */
+ free (buf4); /* { dg-warning "attempt to free a non-heap object" } */
+ free (&e); /* { dg-warning "attempt to free a non-heap object" } */
+ free (&r->a);
+ free ("abcd"); /* { dg-warning "attempt to free a non-heap object" } */
+ free (L"abcd"); /* { dg-warning "attempt to free a non-heap object" } */
+}
diff --git a/gcc/testsuite/gcc.dg/free-2.c b/gcc/testsuite/gcc.dg/free-2.c
new file mode 100644
index 00000000000..eb94651311b
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/free-2.c
@@ -0,0 +1,26 @@
+/* PR c/36970 */
+/* { dg-do compile } */
+/* { dg-options "-O0" } */
+
+extern void free (void *);
+
+char *p, buf3[10], d;
+struct S { char a; int b; } *r;
+
+void foo (void)
+{
+ char buf[10], buf2[10], c;
+ static char buf4[10], e;
+ char *q = buf;
+ free (p);
+ free (q); /* At -O0 no warning is reported here. */
+ free (buf2); /* { dg-warning "attempt to free a non-heap object" } */
+ free (&c); /* { dg-warning "attempt to free a non-heap object" } */
+ free (buf3); /* { dg-warning "attempt to free a non-heap object" } */
+ free (&d); /* { dg-warning "attempt to free a non-heap object" } */
+ free (buf4); /* { dg-warning "attempt to free a non-heap object" } */
+ free (&e); /* { dg-warning "attempt to free a non-heap object" } */
+ free (&r->a);
+ free ("abcd"); /* { dg-warning "attempt to free a non-heap object" } */
+ free (L"abcd"); /* { dg-warning "attempt to free a non-heap object" } */
+}
diff --git a/gcc/testsuite/gcc.dg/pch/cpp-3.c b/gcc/testsuite/gcc.dg/pch/cpp-3.c
new file mode 100644
index 00000000000..25b5ca4077f
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/pch/cpp-3.c
@@ -0,0 +1,13 @@
+/* PR preprocessor/36649 */
+/* { dg-do compile } */
+/* { dg-options "-H -I." } */
+/* { dg-message "cpp-3.h\[^\n\]*(\n\[^\n\]*cpp-3.c)?\n\[^\n\]*cpp-3a.h\n\[^\n\]*cpp-3b.h" "" { target *-*-* } 0 } */
+
+#include "cpp-3.h"
+#include "cpp-3a.h"
+
+int
+main (void)
+{
+ return 0;
+}
diff --git a/gcc/testsuite/gcc.dg/pch/cpp-3.hs b/gcc/testsuite/gcc.dg/pch/cpp-3.hs
new file mode 100644
index 00000000000..728b1afc7fb
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/pch/cpp-3.hs
@@ -0,0 +1,4 @@
+#ifndef CPP_3_H
+#define CPP_3_H
+/* empty */
+#endif
diff --git a/gcc/testsuite/gcc.dg/pch/cpp-3a.h b/gcc/testsuite/gcc.dg/pch/cpp-3a.h
new file mode 100644
index 00000000000..3788d11791c
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/pch/cpp-3a.h
@@ -0,0 +1,4 @@
+#ifndef CPP_3A_H
+#define CPP_3A_H
+#include "cpp-3b.h"
+#endif
diff --git a/gcc/testsuite/gcc.dg/pch/cpp-3b.h b/gcc/testsuite/gcc.dg/pch/cpp-3b.h
new file mode 100644
index 00000000000..5cb0e810488
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/pch/cpp-3b.h
@@ -0,0 +1,4 @@
+#ifndef CPP_3B_H
+#define CPP_3B_H
+/* empty */
+#endif
diff --git a/gcc/testsuite/gcc.dg/pr3074-1.c b/gcc/testsuite/gcc.dg/pr3074-1.c
index c2258d57bb1..4716b79da96 100644
--- a/gcc/testsuite/gcc.dg/pr3074-1.c
+++ b/gcc/testsuite/gcc.dg/pr3074-1.c
@@ -2,9 +2,8 @@
/* { dg-do compile } */
/* { dg-options "-Wall" } */
-void foo()
+void foo(int a)
{
- int a;
5 * (a == 1) | (a == 2); /* { dg-warning "no effect" "no effect" } */
}
diff --git a/gcc/testsuite/gcc.dg/pr36997.c b/gcc/testsuite/gcc.dg/pr36997.c
new file mode 100644
index 00000000000..34ee54a6827
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/pr36997.c
@@ -0,0 +1,8 @@
+/* { dg-do compile { target x86_64-*-* i?86-*-* } } */
+/* { dg-options "-std=c99" } */
+
+typedef int __m64 __attribute__ ((__vector_size__ (8), __may_alias__));
+__m64 _mm_add_si64 (__m64 __m1, __m64 __m2)
+{
+ return (__m64) __builtin_ia32_paddq ((long long)__m1, (long long)__m2); /* { dg-error "incompatible type" } */
+}
diff --git a/gcc/testsuite/gcc.dg/torture/pr36978.c b/gcc/testsuite/gcc.dg/torture/pr36978.c
new file mode 100644
index 00000000000..cd1af4ebc08
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/torture/pr36978.c
@@ -0,0 +1,14 @@
+/* { dg-do compile } */
+/* { dg-options "-funswitch-loops" } */
+
+unsigned short status;
+void foo (const _Bool flag)
+{
+ if (status == 2 || status == 7)
+ {
+ while (status != 2 && (status != 7 || !flag))
+ {
+ }
+ }
+}
+
diff --git a/gcc/testsuite/gcc.dg/torture/stackalign/pr16660-1.c b/gcc/testsuite/gcc.dg/torture/stackalign/pr16660-1.c
index b68c3d07ec1..1bff181c24b 100644
--- a/gcc/testsuite/gcc.dg/torture/stackalign/pr16660-1.c
+++ b/gcc/testsuite/gcc.dg/torture/stackalign/pr16660-1.c
@@ -1,10 +1,12 @@
/* { dg-do run } */
+#include "check.h"
+
void
f ()
{
- unsigned long tmp[4] __attribute__((aligned(16)));
- asm("movaps %%xmm0, (%0)" : : "r" (tmp) : "memory");
+ unsigned long tmp[4] __attribute__((aligned(64)));
+ check (&tmp, 64);
}
int
diff --git a/gcc/testsuite/gcc.dg/uninit-1-O0.c b/gcc/testsuite/gcc.dg/uninit-1-O0.c
new file mode 100644
index 00000000000..4fe5d6b111d
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-1-O0.c
@@ -0,0 +1,30 @@
+/* Spurious uninitialized variable warnings, case 1.
+ Taken from cppfiles.c (merge_include_chains) */
+/* { dg-do compile } */
+/* { dg-options "-Wuninitialized" } */
+
+struct list
+{
+ struct list *next;
+ int id;
+};
+
+extern void free (void *);
+
+void remove_dupes (struct list *el)
+{
+ struct list *p, *q, *r; /* { dg-bogus "r" "uninitialized variable warning" } */
+
+ for (p = el; p; p = p->next)
+ {
+ for (q = el; q != p; q = q->next)
+ if (q->id == p->id)
+ {
+ r->next = p->next;
+ free (p);
+ p = r;
+ break;
+ }
+ r = p;
+ }
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-10-O0.c b/gcc/testsuite/gcc.dg/uninit-10-O0.c
new file mode 100644
index 00000000000..f761ac91c41
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-10-O0.c
@@ -0,0 +1,109 @@
+/* { dg-do compile } */
+/* { dg-options "-Wall" } */
+/* On Alpha EV4, dead code elimination and cfg simplification conspired
+ to leave the register containing 'C' marked live, though all references
+ to the variable had been removed. */
+
+struct operand_data
+{
+ struct operand_data *next;
+ int index;
+ const char *predicate;
+ const char *constraint;
+ int mode;
+ unsigned char n_alternatives;
+ char address_p;
+ char strict_low;
+ char eliminable;
+ char seen;
+};
+
+struct data
+{
+ struct data *next;
+ const char *name;
+ const char *template;
+ int code_number;
+ int index_number;
+ int lineno;
+ int n_operands;
+ int n_dups;
+ int n_alternatives;
+ int operand_number;
+ int output_format;
+ struct operand_data operand[40];
+};
+
+extern void message_with_line (int, const char *, ...)
+ __attribute__ ((__format__ (__printf__, 2, 3)));
+extern int have_error;
+
+extern char *strchr (__const char *__s, int __c) __attribute__ ((__pure__));
+
+void
+validate_insn_alternatives (d)
+ struct data *d;
+{
+ int n = 0, start;
+
+ for (start = 0; start < d->n_operands; start++)
+ if (d->operand[start].n_alternatives > 0)
+ {
+ int len, i;
+ const char *p;
+ char c; /* { dg-bogus "used uninitialized" "uninitialized variable warning" } */
+ int which_alternative = 0;
+ int alternative_count_unsure = 0;
+
+ for (p = d->operand[start].constraint; (c = *p); p += len)
+ {
+ len = 1;
+
+ if (len < 1 || (len > 1 && strchr (",#*+=&%!0123456789", c)))
+ {
+ message_with_line (d->lineno,
+ "invalid length %d for char '%c' in alternative %d of operand %d",
+ len, c, which_alternative, start);
+ len = 1;
+ have_error = 1;
+ }
+
+ if (c == ',')
+ {
+ which_alternative++;
+ continue;
+ }
+
+ for (i = 1; i < len; i++)
+ if (p[i] == '\0')
+ {
+ message_with_line (d->lineno,
+ "NUL in alternative %d of operand %d",
+ which_alternative, start);
+ alternative_count_unsure = 1;
+ break;
+ }
+ else if (strchr (",#*", p[i]))
+ {
+ message_with_line (d->lineno,
+ "'%c' in alternative %d of operand %d",
+ p[i], which_alternative, start);
+ alternative_count_unsure = 1;
+ }
+ }
+ if (alternative_count_unsure)
+ have_error = 1;
+ else if (n == 0)
+ n = d->operand[start].n_alternatives;
+ else if (n != d->operand[start].n_alternatives)
+ {
+ message_with_line (d->lineno,
+ "wrong number of alternatives in operand %d",
+ start);
+ have_error = 1;
+ }
+ }
+
+
+ d->n_alternatives = n;
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-11-O0.c b/gcc/testsuite/gcc.dg/uninit-11-O0.c
new file mode 100644
index 00000000000..23af4f69aa0
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-11-O0.c
@@ -0,0 +1,42 @@
+/* Positive test for uninitialized variables. */
+/* { dg-do compile } */
+/* { dg-options "-Wuninitialized" } */
+
+int sink;
+
+void f1(int parm) /* { dg-bogus "uninitialized" "parameter" } */
+{
+ sink = parm; /* { dg-bogus "uninitialized" "parameter" } */
+}
+
+void f2(void)
+{
+ int x;
+ sink = x; /* { dg-warning "is used" "unconditional" } */
+}
+
+void f3(int p)
+{
+ int x; /* { dg-warning "may be used" "conditional" { xfail *-*-* } } */
+ if (p)
+ x = p;
+ sink = x;
+}
+
+void f4(int p)
+{
+ int x; /* { dg-bogus "uninitialized" "easy if" } */
+ if (p)
+ x = 1;
+ else
+ x = 2;
+ sink = x;
+}
+
+void f5(void)
+{
+ int x, i; /* { dg-bogus "uninitialized" "easy loop" } */
+ for (i = 0; i < 10; ++i)
+ x = 1;
+ sink = x;
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-12-O0.c b/gcc/testsuite/gcc.dg/uninit-12-O0.c
new file mode 100644
index 00000000000..7c0664e4dfc
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-12-O0.c
@@ -0,0 +1,12 @@
+/* PR 23497 */
+/* { dg-do compile } */
+/* { dg-options "-Wuninitialized" } */
+
+typedef _Complex float C;
+C foo()
+{
+ C f;
+ __real__ f = 0;
+ __imag__ f = 0;
+ return f;
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-13-O0.c b/gcc/testsuite/gcc.dg/uninit-13-O0.c
new file mode 100644
index 00000000000..af80fa88ca9
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-13-O0.c
@@ -0,0 +1,10 @@
+/* { dg-do compile } */
+/* { dg-options "-Wuninitialized" } */
+
+typedef _Complex float C;
+C foo()
+{
+ C f;
+ __imag__ f = 0; /* { dg-warning "is used" "unconditional" { xfail *-*-* } } */
+ return f;
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-14-O0.c b/gcc/testsuite/gcc.dg/uninit-14-O0.c
new file mode 100644
index 00000000000..abde6ca86e6
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-14-O0.c
@@ -0,0 +1,20 @@
+/* PR 24931 */
+/* { dg-do compile } */
+/* { dg-options "-Wuninitialized" } */
+
+struct p {
+ short x, y;
+};
+
+struct s {
+ int i;
+ struct p p;
+};
+
+struct s f()
+{
+ struct s s;
+ s.p = (struct p){};
+ s.i = (s.p.x || s.p.y);
+ return s;
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-15-O0.c b/gcc/testsuite/gcc.dg/uninit-15-O0.c
new file mode 100644
index 00000000000..a3fd2b63ba7
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-15-O0.c
@@ -0,0 +1,20 @@
+/* { dg-do compile } */
+/* { dg-options "-Wuninitialized" } */
+
+/* XFAIL for now, the uninitialized pass runs before inlining only at -O0. */
+
+inline int __attribute__((always_inline))
+foo (int i)
+{
+ if (i) return 1; /* { dg-warning "is used uninitialized" {} { xfail *-*-* } } */
+ return 0;
+}
+
+void baz();
+
+void bar()
+{
+ int j; /* { dg-message "was declared here" {} { xfail *-*-* } } */
+ for (; foo(j); ++j)
+ baz();
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-2-O0.c b/gcc/testsuite/gcc.dg/uninit-2-O0.c
new file mode 100644
index 00000000000..62a23fa6b64
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-2-O0.c
@@ -0,0 +1,52 @@
+/* Spurious uninitialized variable warnings, case 2.
+ Taken from cpphash.c (macroexpand) */
+/* { dg-do compile } */
+/* { dg-options "-Wuninitialized" } */
+
+struct definition
+{
+ int nargs;
+ int rest_args;
+};
+
+struct cpp_reader;
+
+enum cpp_token
+{
+ CPP_EOF, CPP_POP, CPP_COMMA, CPP_RPAREN
+};
+
+extern enum cpp_token macarg (struct cpp_reader *, int);
+
+void
+macroexpand (struct cpp_reader *pfile, struct definition *defn)
+{
+ int nargs = defn->nargs;
+
+ if (nargs >= 0)
+ {
+ enum cpp_token token; /* { dg-bogus "token" "uninitialized variable warning" } */
+ int i, rest_args;
+ i = 0;
+ rest_args = 0;
+ do
+ {
+ if (rest_args)
+ continue;
+ if (i < nargs || (nargs == 0 && i == 0))
+ {
+ /* if we are working on last arg which absorbs rest of args... */
+ if (i == nargs - 1 && defn->rest_args)
+ rest_args = 1;
+ token = macarg (pfile, rest_args);
+ }
+ else
+ token = macarg (pfile, 0);
+ if (token == CPP_EOF || token == CPP_POP)
+ return;
+
+ i++;
+ }
+ while (token == CPP_COMMA);
+ }
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-3-O0.c b/gcc/testsuite/gcc.dg/uninit-3-O0.c
new file mode 100644
index 00000000000..d3dcf14edec
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-3-O0.c
@@ -0,0 +1,33 @@
+/* Spurious uninit variable warnings, case 3.
+ Inspired by cppexp.c (parse_charconst) */
+/* { dg-do compile } */
+/* { dg-options "-Wuninitialized" } */
+
+extern void error (char *);
+
+int
+parse_charconst (const char *start, const char *end)
+{
+ int c; /* { dg-bogus "c" "uninitialized variable warning" } */
+ int nchars, retval;
+
+ nchars = 0;
+ retval = 0;
+ while (start < end)
+ {
+ c = *start++;
+ if (c == '\'')
+ break;
+ nchars++;
+ retval += c;
+ retval <<= 8;
+ }
+
+ if (nchars == 0)
+ return 0;
+
+ if (c != '\'')
+ error ("malformed character constant");
+
+ return retval;
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-4-O0.c b/gcc/testsuite/gcc.dg/uninit-4-O0.c
new file mode 100644
index 00000000000..0b9aeea7ddb
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-4-O0.c
@@ -0,0 +1,52 @@
+/* Spurious uninit variable warnings, case 4.
+ Simplified version of cppexp.c (cpp_parse_expr).
+
+ This one is really fragile, it gets it right if you take out case
+ 1, or if the structure is replaced by an int, or if the structure
+ has fewer members (!) */
+
+/* { dg-do compile } */
+/* { dg-options "-Wuninitialized" } */
+
+extern void abort (void);
+
+struct operation {
+ short op;
+ char rprio;
+ char flags;
+ char unsignedp;
+ long value;
+};
+
+extern struct operation cpp_lex (void);
+
+void
+cpp_parse_expr (void)
+{
+ int rprio; /* { dg-bogus "rprio" "uninitialized variable warning PR19833" } */
+ struct operation op;
+
+ for (;;)
+ {
+ op = cpp_lex ();
+
+ switch (op.op)
+ {
+ case 0:
+ break;
+ case 1:
+ return;
+ case 2:
+ rprio = 1;
+ break;
+ default:
+ return;
+ }
+
+ if (op.op == 0)
+ return;
+
+ if (rprio != 1)
+ abort();
+ }
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-5-O0.c b/gcc/testsuite/gcc.dg/uninit-5-O0.c
new file mode 100644
index 00000000000..d9784b3f76c
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-5-O0.c
@@ -0,0 +1,39 @@
+/* Spurious uninitialized-variable warnings. */
+
+/* { dg-do compile } */
+/* { dg-options "-Wuninitialized" } */
+
+extern void use(int);
+extern void foo(void);
+
+void
+func1(int cond)
+{
+ int x; /* { dg-bogus "x" "uninitialized variable warning" } */
+
+ if(cond)
+ x = 1;
+
+ foo();
+
+ if(cond)
+ use(x);
+}
+
+void
+func2 (int cond)
+{
+ int x; /* { dg-bogus "x" "uninitialized variable warning" } */
+ int flag = 0;
+
+ if(cond)
+ {
+ x = 1;
+ flag = 1;
+ }
+
+ foo();
+
+ if(flag)
+ use(x);
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-6-O0.c b/gcc/testsuite/gcc.dg/uninit-6-O0.c
new file mode 100644
index 00000000000..e3fefe5e1c5
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-6-O0.c
@@ -0,0 +1,47 @@
+/* Spurious uninitialized variable warnings.
+ This one inspired by java/class.c:build_utf8_ref. */
+
+/* { dg-do compile } */
+/* { dg-options "-Wuninitialized" } */
+
+#include <stddef.h>
+
+struct tree
+{
+ struct tree *car;
+ struct tree *cdr;
+ int type, data;
+};
+
+extern void *malloc(size_t);
+
+#define INTEGER_T 1
+#define PTR_T 2
+
+#define APPEND(TREE, LAST, TYPE, VALUE) \
+do { \
+ struct tree *tmp = malloc (sizeof (struct tree)); \
+ tmp->car = 0; tmp->cdr = 0; tmp->type = TYPE; \
+ tmp->data = VALUE; \
+ if (TREE->car) \
+ LAST->cdr = tmp; \
+ else \
+ TREE->car = tmp; \
+ LAST = tmp; \
+} while(0)
+
+struct tree *
+make_something(int a, int b, int c)
+{
+ struct tree *rv;
+ struct tree *field;
+
+ rv = malloc (sizeof (struct tree));
+ rv->car = 0;
+
+ APPEND(rv, field, INTEGER_T, a); /* { dg-bogus "field" "uninitialized variable warning" { xfail *-*-* } } */
+ APPEND(rv, field, PTR_T, b);
+ APPEND(rv, field, INTEGER_T, c);
+
+ return rv;
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-8-O0.c b/gcc/testsuite/gcc.dg/uninit-8-O0.c
new file mode 100644
index 00000000000..b386896c7ea
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-8-O0.c
@@ -0,0 +1,32 @@
+/* Uninitialized variable warning tests...
+ Inspired by part of optabs.c:expand_binop.
+ May be the same as uninit-1.c. */
+
+/* { dg-do compile } */
+/* { dg-options "-Wuninitialized" } */
+
+#include <limits.h>
+
+void
+add_bignums (int *out, int *x, int *y)
+{
+ int p, sum;
+ int carry; /* { dg-bogus "carry" "uninitialized variable warning" } */
+
+ p = 0;
+ for (; *x; x++, y++, out++, p++)
+ {
+ if (p)
+ sum = *x + *y + carry;
+ else
+ sum = *x + *y;
+
+ if (sum < 0)
+ {
+ carry = 1;
+ sum -= INT_MAX;
+ }
+ else
+ carry = 0;
+ }
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-9-O0.c b/gcc/testsuite/gcc.dg/uninit-9-O0.c
new file mode 100644
index 00000000000..493dd68d908
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-9-O0.c
@@ -0,0 +1,41 @@
+/* Spurious uninitialized variable warnings. Slight variant on the
+ documented case, inspired by reg-stack.c:record_asm_reg_life. */
+
+/* { dg-do compile } */
+/* { dg-options "-Wuninitialized" } */
+
+struct foo
+{
+ int type;
+ struct foo *car;
+ struct foo *cdr;
+ char *data;
+ int data2;
+};
+
+extern void use(struct foo *);
+
+#define CLOBBER 6
+#define PARALLEL 3
+
+void
+func(struct foo *list, int count)
+{
+ int n_clobbers = 0;
+ int i;
+ struct foo **clob_list; /* { dg-bogus "clob_list" "uninitialized variable warning" } */
+
+ if(list[0].type == PARALLEL)
+ {
+ clob_list = __builtin_alloca(count * sizeof(struct foo *));
+
+ for(i = 1; i < count; i++)
+ {
+ if(list[i].type == CLOBBER)
+ clob_list[n_clobbers++] = &list[i];
+ }
+ }
+
+ for(i = 0; i < n_clobbers; i++)
+ use(clob_list[i]);
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-A-O0.c b/gcc/testsuite/gcc.dg/uninit-A-O0.c
new file mode 100644
index 00000000000..69376911563
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-A-O0.c
@@ -0,0 +1,117 @@
+/* Inspired by part of java/parse.y.
+ May be a real bug in CSE. */
+
+/* { dg-do compile } */
+/* { dg-options "-Wall" } */
+
+struct tree
+{
+ struct tree *car, *cdr, *wfl;
+ int code;
+ struct { unsigned int renp:1;
+ unsigned int rtnp:1;
+ unsigned int rpnp:1; } flags;
+};
+typedef struct tree *tree;
+#define NULL_TREE ((tree)0)
+
+/* Codes */
+enum
+{
+ CALL_EXPR, NEW_ARRAY_EXPR, NEW_CLASS_EXPR, CONVERT_EXPR,
+ ARRAY_REF, CONDITIONAL_EXPR, STRING_CST, EXPR_WITH_FILE_LOCATION
+};
+
+/* Flags */
+#define RESOLVE_EXPRESSION_NAME_P(t) ((t)->flags.renp)
+#define RESOLVE_TYPE_NAME_P(t) ((t)->flags.rtnp)
+#define RESOLVE_PACKAGE_NAME_P(t) ((t)->flags.rpnp)
+
+/* Macros */
+#define EXPR_WFL_QUALIFICATION(t) ((t)->wfl)
+#define QUAL_WFL(t) ((t)->wfl)
+#define EXPR_WFL_NODE(t) ((t)->wfl)
+#define TREE_CODE(t) ((t)->code)
+#define TREE_OPERAND(t,x) ((t)->car)
+#define CLASSTYPE_SUPER(t) ((t)->car)
+#define IDENTIFIER_LOCAL_VALUE(t) ((t)->car)
+#define TREE_CHAIN(t) ((t)->cdr)
+#define QUAL_RESOLUTION(t) ((t)->cdr)
+
+extern tree current_class, this_identifier_node;
+extern tree super_identifier_node, length_identifier_node;
+
+tree resolve_and_layout (tree, tree);
+tree lookup_field_wrapper (tree, tree);
+
+void
+qualify_ambiguous_name (id)
+ tree id;
+{
+ tree qual, qual_wfl, decl;
+ tree name; /* { dg-bogus "name" "uninitialized variable warning" } */
+ tree ptr_type; /* { dg-bogus "ptr_type" "uninitialized variable warning" } */
+ int again, new_array_found = 0;
+ int super_found = 0, this_found = 0;
+
+ qual = EXPR_WFL_QUALIFICATION (id);
+ do {
+ qual_wfl = QUAL_WFL (qual);
+ switch (TREE_CODE (qual_wfl))
+ {
+ case CALL_EXPR:
+ qual_wfl = TREE_OPERAND (qual_wfl, 0);
+ if (TREE_CODE (qual_wfl) != EXPR_WITH_FILE_LOCATION)
+ {
+ qual = EXPR_WFL_QUALIFICATION (qual_wfl);
+ qual_wfl = QUAL_WFL (qual);
+ }
+ break;
+ case NEW_ARRAY_EXPR:
+ qual = TREE_CHAIN (qual);
+ new_array_found = again = 1;
+ continue;
+ case NEW_CLASS_EXPR:
+ case CONVERT_EXPR:
+ qual_wfl = TREE_OPERAND (qual_wfl, 0);
+ break;
+ case ARRAY_REF:
+ while (TREE_CODE (qual_wfl) == ARRAY_REF)
+ qual_wfl = TREE_OPERAND (qual_wfl, 0);
+ break;
+ default:
+ break;
+ }
+
+ name = EXPR_WFL_NODE (qual_wfl);
+ ptr_type = current_class;
+ again = 0;
+
+ } while (again);
+
+ /* If you put straightforward uses of name and ptr_type here
+ instead of the if-else sequence below, the warnings go away.
+ Therefore I suspect a real bug. */
+
+ if (!this_found && !super_found && (decl = IDENTIFIER_LOCAL_VALUE (name)))
+ {
+ RESOLVE_EXPRESSION_NAME_P (qual_wfl) = 1;
+ QUAL_RESOLUTION (qual) = decl;
+ }
+ else if ((decl = lookup_field_wrapper (ptr_type, name))
+ || (new_array_found && name == length_identifier_node))
+ {
+ RESOLVE_EXPRESSION_NAME_P (qual_wfl) = 1;
+ QUAL_RESOLUTION (qual) = (new_array_found ? NULL_TREE : decl);
+ }
+ else if ((decl = resolve_and_layout (name, NULL_TREE)))
+ {
+ RESOLVE_TYPE_NAME_P (qual_wfl) = 1;
+ QUAL_RESOLUTION (qual) = decl;
+ }
+ else if (TREE_CODE (QUAL_WFL (qual)) == CALL_EXPR
+ || TREE_CODE (QUAL_WFL (qual)) == ARRAY_REF)
+ RESOLVE_EXPRESSION_NAME_P (qual_wfl) = 1;
+ else
+ RESOLVE_PACKAGE_NAME_P (qual_wfl) = 1;
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-B-O0.c b/gcc/testsuite/gcc.dg/uninit-B-O0.c
new file mode 100644
index 00000000000..e2883a38ea8
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-B-O0.c
@@ -0,0 +1,15 @@
+/* Origin: PR c/179 from Gray Watson <gray@256.com>, adapted as a testcase
+ by Joseph Myers <jsm28@cam.ac.uk>. */
+/* { dg-do compile } */
+/* { dg-options "-Wuninitialized" } */
+extern void foo (int *);
+extern void bar (int);
+
+void
+baz (void)
+{
+ int i;
+ if (i) /* { dg-warning "uninit" "uninit i warning" { xfail *-*-* } } */
+ bar (i);
+ foo (&i);
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-C-O0.c b/gcc/testsuite/gcc.dg/uninit-C-O0.c
new file mode 100644
index 00000000000..305dd36707e
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-C-O0.c
@@ -0,0 +1,21 @@
+/* Spurious uninitialized variable warning, inspired by libgcc2.c. */
+/* { dg-do compile } */
+/* { dg-options "-Wuninitialized" } */
+
+/* Not all platforms support TImode integers. */
+#if defined(__LP64__) && !defined(__hppa__)
+typedef int TItype __attribute__ ((mode (TI)));
+#else
+typedef long TItype;
+#endif
+
+
+TItype
+__subvdi3 (TItype a, TItype b)
+{
+ TItype w;
+
+ w = a - b;
+
+ return w;
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-D-O0.c b/gcc/testsuite/gcc.dg/uninit-D-O0.c
new file mode 100644
index 00000000000..e63cb80aee0
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-D-O0.c
@@ -0,0 +1,9 @@
+/* Test we do not warn about initializing variable with self. */
+/* { dg-do compile } */
+/* { dg-options "-Wuninitialized" } */
+
+int f()
+{
+ int i = i;
+ return i;
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-E-O0.c b/gcc/testsuite/gcc.dg/uninit-E-O0.c
new file mode 100644
index 00000000000..2cc2459663d
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-E-O0.c
@@ -0,0 +1,9 @@
+/* Test we do warn about initializing variable with self when -Winit-self is supplied. */
+/* { dg-do compile } */
+/* { dg-options "-Wuninitialized -Winit-self" } */
+
+int f()
+{
+ int i = i; /* { dg-warning "i" "uninitialized variable warning" } */
+ return i;
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-F-O0.c b/gcc/testsuite/gcc.dg/uninit-F-O0.c
new file mode 100644
index 00000000000..737cc65007e
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-F-O0.c
@@ -0,0 +1,9 @@
+/* Test we do warn about initializing variable with self in the initialization. */
+/* { dg-do compile } */
+/* { dg-options "-Wuninitialized" } */
+
+int f()
+{
+ int i = i + 1; /* { dg-warning "i" "uninitialized variable warning" } */
+ return i;
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-G-O0.c b/gcc/testsuite/gcc.dg/uninit-G-O0.c
new file mode 100644
index 00000000000..d6edffede66
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-G-O0.c
@@ -0,0 +1,9 @@
+/* Test we do not warn about initializing variable with address of self in the initialization. */
+/* { dg-do compile } */
+/* { dg-options "-Wuninitialized" } */
+
+void *f()
+{
+ void *i = &i;
+ return i;
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-H-O0.c b/gcc/testsuite/gcc.dg/uninit-H-O0.c
new file mode 100644
index 00000000000..97221462c02
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-H-O0.c
@@ -0,0 +1,33 @@
+/* PR 14204 */
+/* { dg-do compile } */
+/* { dg-options "-Wall -Werror" } */
+
+#if defined __alpha__
+# define ASM __asm__("$30")
+#elif defined __i386__
+# define ASM __asm__("esp")
+#elif defined (__powerpc__) || defined (__PPC__) || defined (__ppc__) || defined (_POWER)
+# define ASM __asm__("r1")
+#elif defined __s390__
+# define ASM __asm__("r15")
+#elif defined __mips
+# define ASM __asm__("$sp")
+#elif defined __sparc__
+# define ASM __asm__("sp")
+#elif defined __ia64__
+# define ASM __asm__("r12")
+#elif defined __hppa__
+# define ASM __asm__("%r30")
+#elif defined __xtensa__
+# define ASM __asm__("sp")
+#else
+/* The register name should be target-dependent so for other targets,
+ we just silence the test. */
+# define ASM = 0
+#endif
+
+void *load_PCB (void)
+{
+ register void *sp ASM;
+ return sp; /* { dg-bogus "uninitialized" } */
+}
diff --git a/gcc/testsuite/gcc.dg/uninit-I-O0.c b/gcc/testsuite/gcc.dg/uninit-I-O0.c
new file mode 100644
index 00000000000..655f5489279
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/uninit-I-O0.c
@@ -0,0 +1,8 @@
+/* { dg-do compile } */
+/* { dg-options "-Wuninitialized" } */
+
+int sys_msgctl (void)
+{
+ struct { int mode; } setbuf; /* { dg-warning "'setbuf\.mode' is used" {} { xfail *-*-* } } */
+ return setbuf.mode;
+}
diff --git a/gcc/testsuite/gcc.target/mips/ext-1.c b/gcc/testsuite/gcc.target/mips/ext-1.c
new file mode 100644
index 00000000000..1cd111d5e33
--- /dev/null
+++ b/gcc/testsuite/gcc.target/mips/ext-1.c
@@ -0,0 +1,18 @@
+/* { dg-do compile } */
+/* { dg-mips-options "-O -mips64r2" } */
+/* { dg-final { scan-assembler "\tdext\t" } } */
+/* { dg-final { scan-assembler-not "and" } } */
+
+struct
+{
+ unsigned long long a:9;
+ unsigned long long d:35;
+ unsigned long long e:10;
+ unsigned long long f:10;
+} t;
+
+NOMIPS16 unsigned long long
+f (void)
+{
+ return t.d;
+}
diff --git a/gcc/testsuite/gcc.target/powerpc/longcall-1.c b/gcc/testsuite/gcc.target/powerpc/longcall-1.c
new file mode 100644
index 00000000000..e7187f17a83
--- /dev/null
+++ b/gcc/testsuite/gcc.target/powerpc/longcall-1.c
@@ -0,0 +1,13 @@
+/* PR target/35100 */
+/* { dg-do compile { target fpic } } */
+/* { dg-options "-fpic" } */
+
+void foo (void) __attribute__((__longcall__));
+int baz (void) __attribute__((__longcall__));
+
+int
+bar (void)
+{
+ foo ();
+ return baz () + 1;
+}
diff --git a/gcc/testsuite/gnat.dg/boolean_expr1.adb b/gcc/testsuite/gnat.dg/boolean_expr1.adb
new file mode 100644
index 00000000000..ddfe32bfb64
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/boolean_expr1.adb
@@ -0,0 +1,30 @@
+-- PR middle-end/36554
+-- Origin: Laurent Guerby <laurent@guerby.net>
+
+-- { dg-do compile }
+-- { dg-options "-O2" }
+
+package body Boolean_Expr1 is
+
+ function Long_Float_Is_Valid (X : in Long_Float) return Boolean is
+ Is_Nan : constant Boolean := X /= X;
+ Is_P_Inf : constant Boolean := X > Long_Float'Last;
+ Is_M_Inf : constant Boolean := X < Long_Float'First;
+ Is_Invalid : constant Boolean := Is_Nan or Is_P_Inf or Is_M_Inf;
+ begin
+ return not Is_Invalid;
+ end Long_Float_Is_Valid;
+
+ function S (V : in Long_Float) return String is
+ begin
+ if not Long_Float_Is_Valid (V) then
+ return "INVALID";
+ else
+ return "OK";
+ end if;
+ exception
+ when others =>
+ return "ERROR";
+ end S;
+
+end Boolean_Expr1;
diff --git a/gcc/testsuite/gnat.dg/boolean_expr1.ads b/gcc/testsuite/gnat.dg/boolean_expr1.ads
new file mode 100644
index 00000000000..526551135f5
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/boolean_expr1.ads
@@ -0,0 +1,5 @@
+package Boolean_Expr1 is
+
+ function S (V : in Long_Float) return String;
+
+end Boolean_Expr1;
diff --git a/gcc/testsuite/gnat.dg/deferred_const1.adb b/gcc/testsuite/gnat.dg/deferred_const1.adb
new file mode 100644
index 00000000000..79b9f4a0325
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/deferred_const1.adb
@@ -0,0 +1,12 @@
+-- { dg-do compile }
+
+with Text_IO; use Text_IO;
+
+procedure Deferred_Const1 is
+ I : Integer := 16#20_3A_2D_28#;
+ S : constant string(1..4);
+ for S'address use I'address; -- { dg-warning "constant overlays a variable" }
+ pragma Import (Ada, S);
+begin
+ Put_Line (S);
+end;
diff --git a/gcc/testsuite/gnat.dg/deferred_const2.adb b/gcc/testsuite/gnat.dg/deferred_const2.adb
new file mode 100644
index 00000000000..ee06db79cc9
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/deferred_const2.adb
@@ -0,0 +1,11 @@
+-- { dg-do run }
+
+with System; use System;
+with Deferred_Const2_Pkg; use Deferred_Const2_Pkg;
+
+procedure Deferred_Const2 is
+begin
+ if I'Address /= S'Address then
+ raise Program_Error;
+ end if;
+end;
diff --git a/gcc/testsuite/gnat.dg/deferred_const2_pkg.adb b/gcc/testsuite/gnat.dg/deferred_const2_pkg.adb
new file mode 100644
index 00000000000..b81d448863b
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/deferred_const2_pkg.adb
@@ -0,0 +1,11 @@
+with System; use System;
+
+package body Deferred_Const2_Pkg is
+
+ procedure Dummy is begin null; end;
+
+begin
+ if S'Address /= I'Address then
+ raise Program_Error;
+ end if;
+end Deferred_Const2_Pkg;
diff --git a/gcc/testsuite/gnat.dg/deferred_const2_pkg.ads b/gcc/testsuite/gnat.dg/deferred_const2_pkg.ads
new file mode 100644
index 00000000000..c76e5fdb802
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/deferred_const2_pkg.ads
@@ -0,0 +1,12 @@
+package Deferred_Const2_Pkg is
+
+ I : Integer := 16#20_3A_2D_28#;
+
+ pragma Warnings (Off);
+ S : constant string(1..4);
+ for S'address use I'address;
+ pragma Import (Ada, S);
+
+ procedure Dummy;
+
+end Deferred_Const2_Pkg;
diff --git a/gcc/testsuite/gnat.dg/deferred_const3.adb b/gcc/testsuite/gnat.dg/deferred_const3.adb
new file mode 100644
index 00000000000..84554d3063f
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/deferred_const3.adb
@@ -0,0 +1,19 @@
+-- { dg-do run }
+
+with System; use System;
+with Deferred_Const3_Pkg; use Deferred_Const3_Pkg;
+
+procedure Deferred_Const3 is
+begin
+ if C1'Address /= C'Address then
+ raise Program_Error;
+ end if;
+
+ if C2'Address /= C'Address then
+ raise Program_Error;
+ end if;
+
+ if C3'Address /= C'Address then
+ raise Program_Error;
+ end if;
+end;
diff --git a/gcc/testsuite/gnat.dg/deferred_const3_pkg.adb b/gcc/testsuite/gnat.dg/deferred_const3_pkg.adb
new file mode 100644
index 00000000000..e865494454b
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/deferred_const3_pkg.adb
@@ -0,0 +1,19 @@
+with System; use System;
+
+package body Deferred_Const3_Pkg is
+
+ procedure Dummy is begin null; end;
+
+begin
+ if C1'Address /= C'Address then
+ raise Program_Error;
+ end if;
+
+ if C2'Address /= C'Address then
+ raise Program_Error;
+ end if;
+
+ if C3'Address /= C'Address then
+ raise Program_Error;
+ end if;
+end Deferred_Const3_Pkg;
diff --git a/gcc/testsuite/gnat.dg/deferred_const3_pkg.ads b/gcc/testsuite/gnat.dg/deferred_const3_pkg.ads
new file mode 100644
index 00000000000..de6af3d52ac
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/deferred_const3_pkg.ads
@@ -0,0 +1,21 @@
+package Deferred_Const3_Pkg is
+
+ C : constant Natural := 1;
+
+ C1 : constant Natural := 1;
+ for C1'Address use C'Address;
+
+ C2 : constant Natural;
+ for C2'Address use C'Address;
+
+ C3 : constant Natural;
+
+ procedure Dummy;
+
+private
+ C2 : constant Natural := 1;
+
+ C3 : constant Natural := 1;
+ for C3'Address use C'Address;
+
+end Deferred_Const3_Pkg;
diff --git a/gcc/testsuite/gnat.dg/discr10.adb b/gcc/testsuite/gnat.dg/discr10.adb
new file mode 100644
index 00000000000..4ad834fd124
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr10.adb
@@ -0,0 +1,8 @@
+package body Discr10 is
+
+ function Get (X : R) return R is
+ begin
+ return R'(D1 => False, D2 => False, D3 => X.D3);
+ end;
+
+end Discr10;
diff --git a/gcc/testsuite/gnat.dg/discr10.ads b/gcc/testsuite/gnat.dg/discr10.ads
new file mode 100644
index 00000000000..8df7ef146c4
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr10.ads
@@ -0,0 +1,23 @@
+package Discr10 is
+
+ subtype Index is Natural range 0 .. 150;
+
+ type List is array (Index range <>) of Integer;
+
+ type R (D1 : Boolean := True; D2 : Boolean := False; D3 : Index := 0) is
+ record
+ case D2 is
+ when True =>
+ L : List (1 .. D3);
+ case D1 is
+ when True => I : Integer;
+ when False => null;
+ end case;
+ when False =>
+ null;
+ end case;
+ end record;
+
+ function Get (X : R) return R;
+
+end Discr10;
diff --git a/gcc/testsuite/gnat.dg/missing_acc_check.adb b/gcc/testsuite/gnat.dg/missing_acc_check.adb
new file mode 100644
index 00000000000..1c2d9cf502e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/missing_acc_check.adb
@@ -0,0 +1,39 @@
+-- { dg-do run }
+
+procedure Missing_Acc_Check is
+
+ Test_Failed : Exception;
+
+ type Int_Access is access all Integer;
+
+ Save : Int_Access := null;
+
+ type Int_Rec is record
+ Int : aliased Integer;
+ end record;
+
+ type Ltd_Rec (IR_Acc : access Int_Rec) is limited null record;
+
+ function Pass_Rec (IR_Acc : access Int_Rec) return Int_Access is
+ begin
+ return IR_Acc.Int'Access; -- Accessibility check here
+ end Pass_Rec;
+
+ procedure Proc is
+ IR : aliased Int_Rec;
+ LR : Ltd_Rec (IR'Access);
+ begin
+ Save := Pass_Rec (LR.IR_Acc); -- Must raise Program_Error;
+
+ if Save /= null then
+ raise Test_Failed;
+ end if;
+
+ exception
+ when Program_Error =>
+ null;
+ end Proc;
+
+begin
+ Proc;
+end Missing_Acc_Check;
diff --git a/gcc/testsuite/gnat.dg/raise_from_pure.adb b/gcc/testsuite/gnat.dg/raise_from_pure.adb
new file mode 100644
index 00000000000..62e543e94db
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/raise_from_pure.adb
@@ -0,0 +1,11 @@
+package body raise_from_pure is
+ function Raise_CE_If_0 (P : Integer) return Integer is
+ begin
+ if P = 0 then
+ raise Constraint_error;
+ end if;
+ return 1;
+ end;
+end;
+
+
diff --git a/gcc/testsuite/gnat.dg/raise_from_pure.ads b/gcc/testsuite/gnat.dg/raise_from_pure.ads
new file mode 100644
index 00000000000..9c363a5be48
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/raise_from_pure.ads
@@ -0,0 +1,5 @@
+
+package raise_from_pure is
+ pragma Pure;
+ function Raise_CE_If_0 (P : Integer) return Integer;
+end;
diff --git a/gcc/testsuite/gnat.dg/specs/genericppc.ads b/gcc/testsuite/gnat.dg/specs/genericppc.ads
new file mode 100644
index 00000000000..494a8890b05
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/genericppc.ads
@@ -0,0 +1,7 @@
+-- { dg-do compile }
+-- { dg-options "-gnatc" }
+
+generic
+ type T_Item is private;
+function genericppc (T : in t_Item; I : integer) return integer;
+pragma Precondition (I > 0);
diff --git a/gcc/testsuite/gnat.dg/specs/null_aggr_bug.ads b/gcc/testsuite/gnat.dg/specs/null_aggr_bug.ads
new file mode 100644
index 00000000000..95467f428eb
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/null_aggr_bug.ads
@@ -0,0 +1,20 @@
+-- { dg-do compile }
+package Null_Aggr_Bug is
+
+ type Rec1 is null record;
+
+ type Rec2 is tagged null record;
+
+ type Rec3 is new Rec2 with null record;
+
+ X1 : Rec1 := (null record);
+ Y1 : Rec1 := (others => <>);
+
+ X2 : Rec2 := (null record);
+ Y2 : Rec2 := (others => <>);
+
+ X3 : Rec3 := (null record);
+ Y3 : Rec3 := (others => <>);
+ Z3 : Rec3 := (Rec2 with others => <>);
+
+end Null_Aggr_Bug;
diff --git a/gcc/testsuite/gnat.dg/specs/sync_iface_test.ads b/gcc/testsuite/gnat.dg/specs/sync_iface_test.ads
new file mode 100644
index 00000000000..4bccd255d7a
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/sync_iface_test.ads
@@ -0,0 +1,14 @@
+-- { dg-do compile }
+-- { dg-options "-gnatc" }
+
+package Sync_Iface_Test is
+ type Iface is limited interface;
+ procedure Do_Test
+ (Container : in out Iface;
+ Process : access procedure (E : Natural)) is abstract;
+
+ protected type Buffer is new Iface with
+ overriding procedure Do_Test
+ (Process : access procedure (E : Natural));
+ end;
+end;
diff --git a/gcc/testsuite/gnat.dg/sync_iface_test.adb b/gcc/testsuite/gnat.dg/sync_iface_test.adb
new file mode 100644
index 00000000000..f431adfe243
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/sync_iface_test.adb
@@ -0,0 +1,19 @@
+-- { dg-do compile }
+package body Sync_Iface_Test is
+ protected body Buffer is
+ procedure Dummy is begin null; end;
+ end;
+
+ function First (Obj : Buffer) return Natural is
+ begin
+ return 0;
+ end;
+
+ procedure Do_Test (Dummy : Natural; Item : Buffer)
+ is
+ Position1 : Natural := First (Item);
+ Position2 : Natural := Item.First; -- Problem here
+ begin
+ null;
+ end;
+end;
diff --git a/gcc/testsuite/gnat.dg/sync_iface_test.ads b/gcc/testsuite/gnat.dg/sync_iface_test.ads
new file mode 100644
index 00000000000..c172d7fa2b1
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/sync_iface_test.ads
@@ -0,0 +1,11 @@
+package Sync_Iface_Test is
+ type Iface is limited interface;
+ function First (Obj : Iface) return Natural is abstract;
+
+ protected type Buffer is new Iface with
+ procedure Dummy;
+ end;
+ overriding function First (Obj : Buffer) return Natural;
+
+ procedure Do_Test (Dummy : Natural; Item : Buffer);
+end;
diff --git a/gcc/testsuite/gnat.dg/test_raise_from_pure.adb b/gcc/testsuite/gnat.dg/test_raise_from_pure.adb
new file mode 100644
index 00000000000..ab1ed16db5c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/test_raise_from_pure.adb
@@ -0,0 +1,9 @@
+-- { dg-do run }
+-- { dg-options "-O2" }
+with Wrap_Raise_From_Pure; use Wrap_Raise_From_Pure;
+procedure test_raise_from_pure is
+begin
+ Wrap_Raise_From_Pure.Check;
+exception
+ when Constraint_Error => null;
+end;
diff --git a/gcc/testsuite/gnat.dg/wrap_raise_from_pure.adb b/gcc/testsuite/gnat.dg/wrap_raise_from_pure.adb
new file mode 100644
index 00000000000..ec8f342c6b5
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/wrap_raise_from_pure.adb
@@ -0,0 +1,10 @@
+with Ada.Text_Io; use Ada.Text_Io;
+with Raise_From_Pure; use Raise_From_Pure;
+package body Wrap_Raise_From_Pure is
+ procedure Check is
+ K : Integer;
+ begin
+ K := Raise_CE_If_0 (0);
+ Put_Line ("Should never reach here");
+ end;
+end;
diff --git a/gcc/testsuite/gnat.dg/wrap_raise_from_pure.ads b/gcc/testsuite/gnat.dg/wrap_raise_from_pure.ads
new file mode 100644
index 00000000000..521c04a5fc9
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/wrap_raise_from_pure.ads
@@ -0,0 +1,4 @@
+
+package Wrap_Raise_From_Pure is
+ procedure Check;
+end;
diff --git a/gcc/tree-pass.h b/gcc/tree-pass.h
index 1e1463fc5fa..ea7e34334ee 100644
--- a/gcc/tree-pass.h
+++ b/gcc/tree-pass.h
@@ -104,7 +104,8 @@ struct opt_pass
SIMPLE_IPA_PASS,
IPA_PASS
} type;
- /* Terse name of the pass used as a fragment of the dump file name. */
+ /* Terse name of the pass used as a fragment of the dump file
+ name. If the name starts with a star, no dump happens. */
const char *name;
/* If non-null, this pass and all sub-passes are executed only if
diff --git a/gcc/tree-ssa-ccp.c b/gcc/tree-ssa-ccp.c
index 44b5523263d..b867bba08d5 100644
--- a/gcc/tree-ssa-ccp.c
+++ b/gcc/tree-ssa-ccp.c
@@ -989,7 +989,13 @@ ccp_fold (gimple stmt)
allowed places. */
if ((subcode == NOP_EXPR || subcode == CONVERT_EXPR)
&& ((POINTER_TYPE_P (TREE_TYPE (lhs))
- && POINTER_TYPE_P (TREE_TYPE (op0)))
+ && POINTER_TYPE_P (TREE_TYPE (op0))
+ /* Do not allow differences in volatile qualification
+ as this might get us confused as to whether a
+ propagation destination statement is volatile
+ or not. See PR36988. */
+ && (TYPE_VOLATILE (TREE_TYPE (TREE_TYPE (lhs)))
+ == TYPE_VOLATILE (TREE_TYPE (TREE_TYPE (op0)))))
|| useless_type_conversion_p (TREE_TYPE (lhs),
TREE_TYPE (op0))))
return op0;
diff --git a/gcc/tree-ssa-loop-ivcanon.c b/gcc/tree-ssa-loop-ivcanon.c
index dc863f8b8a5..00965465342 100644
--- a/gcc/tree-ssa-loop-ivcanon.c
+++ b/gcc/tree-ssa-loop-ivcanon.c
@@ -184,10 +184,6 @@ try_unroll_loop_completely (struct loop *loop,
ninsns = tree_num_loop_insns (loop, &eni_size_weights);
- if (n_unroll * ninsns
- > (unsigned) PARAM_VALUE (PARAM_MAX_COMPLETELY_PEELED_INSNS))
- return false;
-
unr_insns = estimated_unrolled_size (ninsns, n_unroll);
if (dump_file && (dump_flags & TDF_DETAILS))
{
@@ -196,6 +192,17 @@ try_unroll_loop_completely (struct loop *loop,
(int) unr_insns);
}
+ if (unr_insns > ninsns
+ && (unr_insns
+ > (unsigned) PARAM_VALUE (PARAM_MAX_COMPLETELY_PEELED_INSNS)))
+ {
+ if (dump_file && (dump_flags & TDF_DETAILS))
+ fprintf (dump_file, "Not unrolling loop %d "
+ "(--param max-completely-peeled-insns limit reached).\n",
+ loop->num);
+ return false;
+ }
+
if (ul == UL_NO_GROWTH
&& unr_insns > ninsns)
{
diff --git a/gcc/tree-ssa-loop-unswitch.c b/gcc/tree-ssa-loop-unswitch.c
index 8ece4aca4ab..850270f49c0 100644
--- a/gcc/tree-ssa-loop-unswitch.c
+++ b/gcc/tree-ssa-loop-unswitch.c
@@ -123,8 +123,8 @@ tree_may_unswitch_on (basic_block bb, struct loop *loop)
return NULL_TREE;
}
- cond = fold_build2 (gimple_cond_code (stmt), boolean_type_node,
- gimple_cond_lhs (stmt), gimple_cond_rhs (stmt));
+ cond = build2 (gimple_cond_code (stmt), boolean_type_node,
+ gimple_cond_lhs (stmt), gimple_cond_rhs (stmt));
/* To keep the things simple, we do not directly remove the conditions,
but just replace tests with 0/1. Prevent the infinite loop where we
diff --git a/gcc/tree-ssa-pre.c b/gcc/tree-ssa-pre.c
index c98a18a772c..336c54ec700 100644
--- a/gcc/tree-ssa-pre.c
+++ b/gcc/tree-ssa-pre.c
@@ -4086,7 +4086,7 @@ init_pre (bool do_fre)
/* Deallocate data structures used by PRE. */
static void
-fini_pre (void)
+fini_pre (bool do_fre)
{
basic_block bb;
@@ -4117,7 +4117,7 @@ fini_pre (void)
BITMAP_FREE (need_eh_cleanup);
- if (current_loops != NULL)
+ if (!do_fre)
loop_optimizer_finalize ();
}
@@ -4192,7 +4192,7 @@ execute_pre (bool do_fre ATTRIBUTE_UNUSED)
if (!do_fre)
remove_dead_inserted_code ();
- fini_pre ();
+ fini_pre (do_fre);
return todo;
}
diff --git a/gnattools/ChangeLog b/gnattools/ChangeLog
index 81f32c10965..169a0143f99 100644
--- a/gnattools/ChangeLog
+++ b/gnattools/ChangeLog
@@ -1,3 +1,14 @@
+2008-08-01 Paolo Bonzini <bonzini@gnu.org>
+
+ * configure.ac (warn_cflags): Substitute.
+ * configure: Regenerate.
+ * Makefile.in (libdir, exeext, WARN_CFLAGS): Substitute.
+ (GCC_WARN_CFLAGS): Remove NOCOMMON_FLAG.
+ (ADA_INCLUDE_DIR, ADA_RTL_OBJ_DIR): Remove as they were unused.
+ (libsubdir): Remove.
+ (libada-mk): Do not include. Include libgcc.mvars instead.
+ (xmake_file): Remove, do not include.
+
2008-07-30 Paolo Bonzini <bonzini@gnu.org>
* configure.ac (x_ada_cflags): Remove.
diff --git a/gnattools/Makefile.in b/gnattools/Makefile.in
index f28bc685a49..ed40ba54411 100644
--- a/gnattools/Makefile.in
+++ b/gnattools/Makefile.in
@@ -21,6 +21,7 @@ all: gnattools
# Standard autoconf-set variables.
SHELL = @SHELL@
srcdir = @srcdir@
+libdir = @libdir@
build = @build@
target = @target@
prefix = @prefix@
@@ -33,6 +34,7 @@ LN_S=@LN_S@
target_noncanonical=@target_noncanonical@
# Variables for the user (or the top level) to override.
+exeext = @EXEEXT@
objext=.o
TRACE=no
ADA_FOR_BUILD=
@@ -43,27 +45,16 @@ PWD_COMMAND = $${PWDCMD-pwd}
# The tedious process of getting CFLAGS right.
CFLAGS=-g
LOOSE_WARN = -W -Wall -Wwrite-strings -Wstrict-prototypes -Wmissing-prototypes
-GCC_WARN_CFLAGS = $(LOOSE_WARN) $(NOCOMMON_FLAG)
+GCC_WARN_CFLAGS = $(LOOSE_WARN)
+WARN_CFLAGS = @warn_cflags@
ADA_CFLAGS=@ADA_CFLAGS@
# Variables for gnattools.
ADAFLAGS= -gnatpg -gnata
-ADA_INCLUDE_DIR = $(libsubdir)/adainclude
-ADA_RTL_OBJ_DIR = $(libsubdir)/adalib
# For finding the GCC build dir, which is used far too much
GCC_DIR=../gcc
-# Include fragment generated by GCC configure; shared with libada for now.
-include $(GCC_DIR)/libada-mk
-# Variables based on those gleaned from the GCC makefile. :-P
-libsubdir=$(libdir)/gcc/$(target_noncanonical)/$(gcc_version)
-
-# Get possible host-specific override for libsubdir (ick).
-xmake_file=$(subst /config,/../gcc/config,$(gcc_xmake_file))
-ifneq ($(xmake_file),)
-include $(xmake_file)
-endif
# Absolute srcdir for gcc/ada (why do we want absolute? I dunno)
fsrcdir := $(shell cd $(srcdir)/../gcc/ada/; ${PWD_COMMAND})
diff --git a/gnattools/configure b/gnattools/configure
index 3cd9eef4c5c..7e5513b0118 100755
--- a/gnattools/configure
+++ b/gnattools/configure
@@ -272,7 +272,7 @@ PACKAGE_STRING=
PACKAGE_BUGREPORT=
ac_unique_file="Makefile.in"
-ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAINT INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os target_noncanonical LN_S default_gnattools_target TOOLS_TARGET_PAIRS EXTRA_GNATTOOLS ADA_CFLAGS LIBOBJS LTLIBOBJS'
+ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAINT INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os target_noncanonical LN_S default_gnattools_target TOOLS_TARGET_PAIRS EXTRA_GNATTOOLS ADA_CFLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT warn_cflags LIBOBJS LTLIBOBJS'
ac_subst_files=''
ac_pwd=`pwd`
@@ -714,6 +714,22 @@ ac_env_target_alias_set=${target_alias+set}
ac_env_target_alias_value=$target_alias
ac_cv_env_target_alias_set=${target_alias+set}
ac_cv_env_target_alias_value=$target_alias
+ac_env_CC_set=${CC+set}
+ac_env_CC_value=$CC
+ac_cv_env_CC_set=${CC+set}
+ac_cv_env_CC_value=$CC
+ac_env_CFLAGS_set=${CFLAGS+set}
+ac_env_CFLAGS_value=$CFLAGS
+ac_cv_env_CFLAGS_set=${CFLAGS+set}
+ac_cv_env_CFLAGS_value=$CFLAGS
+ac_env_LDFLAGS_set=${LDFLAGS+set}
+ac_env_LDFLAGS_value=$LDFLAGS
+ac_cv_env_LDFLAGS_set=${LDFLAGS+set}
+ac_cv_env_LDFLAGS_value=$LDFLAGS
+ac_env_CPPFLAGS_set=${CPPFLAGS+set}
+ac_env_CPPFLAGS_value=$CPPFLAGS
+ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set}
+ac_cv_env_CPPFLAGS_value=$CPPFLAGS
#
# Report the --help message.
@@ -793,6 +809,17 @@ Optional Features:
enable make rules and dependencies not useful (and
sometimes confusing) to the casual installer
+Some influential environment variables:
+ CC C compiler command
+ CFLAGS C compiler flags
+ LDFLAGS linker flags, e.g. -L<lib dir> if you have libraries in a
+ nonstandard directory <lib dir>
+ CPPFLAGS C/C++ preprocessor flags, e.g. -I<include dir> if you have
+ headers in a nonstandard directory <include dir>
+
+Use these variables to override the choices made by `configure' or to help
+it to find libraries and programs with nonstandard names/locations.
+
_ACEOF
fi
@@ -1589,6 +1616,952 @@ esac
# From user or toplevel makefile.
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}gcc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_CC="${ac_tool_prefix}gcc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$ac_cv_prog_CC"; then
+ ac_ct_CC=$CC
+ # Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_CC"; then
+ ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_CC="gcc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+ echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
+echo "${ECHO_T}$ac_ct_CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ CC=$ac_ct_CC
+else
+ CC="$ac_cv_prog_CC"
+fi
+
+if test -z "$CC"; then
+ if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}cc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_CC="${ac_tool_prefix}cc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$ac_cv_prog_CC"; then
+ ac_ct_CC=$CC
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_CC"; then
+ ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_CC="cc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+ echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
+echo "${ECHO_T}$ac_ct_CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ CC=$ac_ct_CC
+else
+ CC="$ac_cv_prog_CC"
+fi
+
+fi
+if test -z "$CC"; then
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ ac_prog_rejected=no
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# != 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@"
+ fi
+fi
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$CC"; then
+ if test -n "$ac_tool_prefix"; then
+ for ac_prog in cl
+ do
+ # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ test -n "$CC" && break
+ done
+fi
+if test -z "$CC"; then
+ ac_ct_CC=$CC
+ for ac_prog in cl
+do
+ # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_CC"; then
+ ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_CC="$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+ echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
+echo "${ECHO_T}$ac_ct_CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ test -n "$ac_ct_CC" && break
+done
+
+ CC=$ac_ct_CC
+fi
+
+fi
+
+
+test -z "$CC" && { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5
+echo "$as_me: error: in \`$ac_pwd':" >&2;}
+{ { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH
+See \`config.log' for more details." >&5
+echo "$as_me: error: no acceptable C compiler found in \$PATH
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }; }
+
+# Provide some information about the compiler.
+echo "$as_me:$LINENO:" \
+ "checking for C compiler version" >&5
+ac_compiler=`set X $ac_compile; echo $2`
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5
+ (eval $ac_compiler --version </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v </dev/null >&5\"") >&5
+ (eval $ac_compiler -v </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V </dev/null >&5\"") >&5
+ (eval $ac_compiler -V </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files a.out a.exe b.out"
+# Try to create an executable without -o first, disregard a.out.
+# It will help us diagnose broken compilers, and finding out an intuition
+# of exeext.
+echo "$as_me:$LINENO: checking for C compiler default output file name" >&5
+echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6
+ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
+if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5
+ (eval $ac_link_default) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ # Find the output, starting from the most likely. This scheme is
+# not robust to junk in `.', hence go to wildcards (a.*) only as a last
+# resort.
+
+# Be careful to initialize this variable, since it used to be cached.
+# Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile.
+ac_cv_exeext=
+# b.out is created by i960 compilers.
+for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out
+do
+ test -f "$ac_file" || continue
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj )
+ ;;
+ conftest.$ac_ext )
+ # This is the source file.
+ ;;
+ [ab].out )
+ # We found the default executable, but exeext='' is most
+ # certainly right.
+ break;;
+ *.* )
+ ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+ # FIXME: I believe we export ac_cv_exeext for Libtool,
+ # but it would be cool to find out if it's true. Does anybody
+ # maintain Libtool? --akim.
+ export ac_cv_exeext
+ break;;
+ * )
+ break;;
+ esac
+done
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5
+echo "$as_me: error: in \`$ac_pwd':" >&2;}
+{ { echo "$as_me:$LINENO: error: C compiler cannot create executables
+See \`config.log' for more details." >&5
+echo "$as_me: error: C compiler cannot create executables
+See \`config.log' for more details." >&2;}
+ { (exit 77); exit 77; }; }; }
+fi
+
+ac_exeext=$ac_cv_exeext
+echo "$as_me:$LINENO: result: $ac_file" >&5
+echo "${ECHO_T}$ac_file" >&6
+
+# Check the compiler produces executables we can run. If not, either
+# the compiler is broken, or we cross compile.
+echo "$as_me:$LINENO: checking whether the C compiler works" >&5
+echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6
+# FIXME: These cross compiler hacks should be removed for Autoconf 3.0
+# If not cross compiling, check that we can run a simple program.
+if test "$cross_compiling" != yes; then
+ if { ac_try='./$ac_file'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ cross_compiling=no
+ else
+ if test "$cross_compiling" = maybe; then
+ cross_compiling=yes
+ else
+ { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5
+echo "$as_me: error: in \`$ac_pwd':" >&2;}
+{ { echo "$as_me:$LINENO: error: cannot run C compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot run C compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }; }
+ fi
+ fi
+fi
+echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6
+
+rm -f a.out a.exe conftest$ac_cv_exeext b.out
+ac_clean_files=$ac_clean_files_save
+# Check the compiler produces executables we can run. If not, either
+# the compiler is broken, or we cross compile.
+echo "$as_me:$LINENO: checking whether we are cross compiling" >&5
+echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6
+echo "$as_me:$LINENO: result: $cross_compiling" >&5
+echo "${ECHO_T}$cross_compiling" >&6
+
+echo "$as_me:$LINENO: checking for suffix of executables" >&5
+echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ # If both `conftest.exe' and `conftest' are `present' (well, observable)
+# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will
+# work properly (i.e., refer to `conftest.exe'), while it won't with
+# `rm'.
+for ac_file in conftest.exe conftest conftest.*; do
+ test -f "$ac_file" || continue
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;;
+ *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+ export ac_cv_exeext
+ break;;
+ * ) break;;
+ esac
+done
+else
+ { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5
+echo "$as_me: error: in \`$ac_pwd':" >&2;}
+{ { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }; }
+fi
+
+rm -f conftest$ac_cv_exeext
+echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5
+echo "${ECHO_T}$ac_cv_exeext" >&6
+
+rm -f conftest.$ac_ext
+EXEEXT=$ac_cv_exeext
+ac_exeext=$EXEEXT
+echo "$as_me:$LINENO: checking for suffix of object files" >&5
+echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6
+if test "${ac_cv_objext+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.o conftest.obj
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;;
+ *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
+ break;;
+ esac
+done
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5
+echo "$as_me: error: in \`$ac_pwd':" >&2;}
+{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot compute suffix of object files: cannot compile
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }; }
+fi
+
+rm -f conftest.$ac_cv_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_objext" >&5
+echo "${ECHO_T}$ac_cv_objext" >&6
+OBJEXT=$ac_cv_objext
+ac_objext=$OBJEXT
+echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5
+echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6
+if test "${ac_cv_c_compiler_gnu+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+#ifndef __GNUC__
+ choke me
+#endif
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_compiler_gnu=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_compiler_gnu=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_cv_c_compiler_gnu=$ac_compiler_gnu
+
+fi
+echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5
+echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6
+GCC=`test $ac_compiler_gnu = yes && echo yes`
+ac_test_CFLAGS=${CFLAGS+set}
+ac_save_CFLAGS=$CFLAGS
+CFLAGS="-g"
+echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5
+echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6
+if test "${ac_cv_prog_cc_g+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_prog_cc_g=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_prog_cc_g=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5
+echo "${ECHO_T}$ac_cv_prog_cc_g" >&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS=$ac_save_CFLAGS
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5
+echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6
+if test "${ac_cv_prog_cc_stdc+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_cv_prog_cc_stdc=no
+ac_save_CC=$CC
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <stdarg.h>
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */
+struct buf { int x; };
+FILE * (*rcsopen) (struct buf *, struct stat *, int);
+static char *e (p, i)
+ char **p;
+ int i;
+{
+ return p[i];
+}
+static char *f (char * (*g) (char **, int), char **p, ...)
+{
+ char *s;
+ va_list v;
+ va_start (v,p);
+ s = g (p, va_arg (v,int));
+ va_end (v);
+ return s;
+}
+
+/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has
+ function prototypes and stuff, but not '\xHH' hex character constants.
+ These don't provoke an error unfortunately, instead are silently treated
+ as 'x'. The following induces an error, until -std1 is added to get
+ proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an
+ array size at least. It's necessary to write '\x00'==0 to get something
+ that's true only with -std1. */
+int osf4_cc_array ['\x00' == 0 ? 1 : -1];
+
+int test (int i, double x);
+struct s1 {int (*f) (int a);};
+struct s2 {int (*f) (double a);};
+int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
+int argc;
+char **argv;
+int
+main ()
+{
+return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1];
+ ;
+ return 0;
+}
+_ACEOF
+# Don't try gcc -ansi; that turns off useful extensions and
+# breaks some systems' header files.
+# AIX -qlanglvl=ansi
+# Ultrix and OSF/1 -std1
+# HP-UX 10.20 and later -Ae
+# HP-UX older versions -Aa -D_HPUX_SOURCE
+# SVR4 -Xc -D__EXTENSIONS__
+for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
+do
+ CC="$ac_save_CC $ac_arg"
+ rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_prog_cc_stdc=$ac_arg
+break
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+fi
+rm -f conftest.err conftest.$ac_objext
+done
+rm -f conftest.$ac_ext conftest.$ac_objext
+CC=$ac_save_CC
+
+fi
+
+case "x$ac_cv_prog_cc_stdc" in
+ x|xno)
+ echo "$as_me:$LINENO: result: none needed" >&5
+echo "${ECHO_T}none needed" >&6 ;;
+ *)
+ echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5
+echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6
+ CC="$CC $ac_cv_prog_cc_stdc" ;;
+esac
+
+# Some people use a C++ compiler to compile C. Since we use `exit',
+# in C++ we need to declare it. In case someone uses the same compiler
+# for both compiling C and C++ we need to have the C++ compiler decide
+# the declaration of exit, since it's the most demanding environment.
+cat >conftest.$ac_ext <<_ACEOF
+#ifndef __cplusplus
+ choke me
+#endif
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ for ac_declaration in \
+ '' \
+ 'extern "C" void std::exit (int) throw (); using std::exit;' \
+ 'extern "C" void std::exit (int); using std::exit;' \
+ 'extern "C" void exit (int) throw ();' \
+ 'extern "C" void exit (int);' \
+ 'void exit (int);'
+do
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_declaration
+#include <stdlib.h>
+int
+main ()
+{
+exit (42);
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ :
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+continue
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_declaration
+int
+main ()
+{
+exit (42);
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ break
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+done
+rm -f conftest*
+if test -n "$ac_declaration"; then
+ echo '#ifdef __cplusplus' >>confdefs.h
+ echo $ac_declaration >>confdefs.h
+ echo '#endif' >>confdefs.h
+fi
+
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+warn_cflags=
+if test "x$GCC" = "xyes"; then
+ warn_cflags='$(GCC_WARN_CFLAGS)'
+fi
+
+
# Output: create a Makefile.
ac_config_files="$ac_config_files Makefile"
@@ -2250,6 +3223,14 @@ s,@default_gnattools_target@,$default_gnattools_target,;t t
s,@TOOLS_TARGET_PAIRS@,$TOOLS_TARGET_PAIRS,;t t
s,@EXTRA_GNATTOOLS@,$EXTRA_GNATTOOLS,;t t
s,@ADA_CFLAGS@,$ADA_CFLAGS,;t t
+s,@CC@,$CC,;t t
+s,@CFLAGS@,$CFLAGS,;t t
+s,@LDFLAGS@,$LDFLAGS,;t t
+s,@CPPFLAGS@,$CPPFLAGS,;t t
+s,@ac_ct_CC@,$ac_ct_CC,;t t
+s,@EXEEXT@,$EXEEXT,;t t
+s,@OBJEXT@,$OBJEXT,;t t
+s,@warn_cflags@,$warn_cflags,;t t
s,@LIBOBJS@,$LIBOBJS,;t t
s,@LTLIBOBJS@,$LTLIBOBJS,;t t
CEOF
diff --git a/gnattools/configure.ac b/gnattools/configure.ac
index 965dc8e18e5..ac0c6926633 100644
--- a/gnattools/configure.ac
+++ b/gnattools/configure.ac
@@ -156,6 +156,13 @@ esac
# From user or toplevel makefile.
AC_SUBST(ADA_CFLAGS)
+AC_PROG_CC
+warn_cflags=
+if test "x$GCC" = "xyes"; then
+ warn_cflags='$(GCC_WARN_CFLAGS)'
+fi
+AC_SUBST(warn_cflags)
+
# Output: create a Makefile.
AC_CONFIG_FILES([Makefile])
diff --git a/libada/ChangeLog b/libada/ChangeLog
index bf20ed52d24..6c60719ec31 100644
--- a/libada/ChangeLog
+++ b/libada/ChangeLog
@@ -1,3 +1,16 @@
+2008-08-01 Paolo Bonzini <bonzini@gnu.org>
+
+ * configure.ac (warn_cflags): Substitute.
+ * configure: Regenerate.
+ * Makefile.in (libdir, WARN_CFLAGS): Substitute.
+ (GCC_WARN_CFLAGS): Remove NOCOMMON_FLAG.
+ (ADA_CFLAGS, T_ADA_CFLAGS, X_ADA_CFLAGS, ALL_ADA_CFLAGS): Remove,
+ they were unused.
+ (libada-mk): Do not include. Include libgcc.mvars instead.
+ (tmake_file): Remove, do not include.
+ (FLAGS_TO_PASS): Pass dummy values for exeext and CC.
+ * configure: Regenerate.
+
2008-06-17 Ralf Wildenhues <Ralf.Wildenhues@gmx.de>
* configure.ac: move sinclude of acx.m4 before AC_INIT,
diff --git a/libada/Makefile.in b/libada/Makefile.in
index 23d6713a5b3..5e5792db559 100644
--- a/libada/Makefile.in
+++ b/libada/Makefile.in
@@ -21,6 +21,7 @@ all: gnatlib
# Standard autoconf-set variables.
SHELL = @SHELL@
srcdir = @srcdir@
+libdir = @libdir@
build = @build@
target = @target@
prefix = @prefix@
@@ -39,41 +40,30 @@ LDFLAGS=
# The tedious process of getting CFLAGS right.
CFLAGS=-g
LOOSE_WARN = -W -Wall -Wwrite-strings -Wstrict-prototypes -Wmissing-prototypes
-GCC_WARN_CFLAGS = $(LOOSE_WARN) $(NOCOMMON_FLAG)
+GCC_WARN_CFLAGS = $(LOOSE_WARN)
+WARN_CFLAGS = @warn_cflags@
-ADA_CFLAGS=
-T_ADA_CFLAGS=
-# HPPA is literally the only target which sets X_ADA_CFLAGS
-X_ADA_CFLAGS=@x_ada_cflags@
-ALL_ADA_CFLAGS=$(X_ADA_CFLAGS) $(T_ADA_CFLAGS) $(ADA_CFLAGS)
+TARGET_LIBGCC2_CFLAGS=
+GNATLIBCFLAGS= -g -O2
-# For finding the GCC build dir, which is used far too much
+# Get target-specific overrides for TARGET_LIBGCC2_CFLAGS.
host_subdir = @host_subdir@
GCC_DIR=../../$(host_subdir)/gcc
-# Include fragment generated by GCC configure.
-include $(GCC_DIR)/libada-mk
-
-TARGET_LIBGCC2_CFLAGS=
-GNATLIBCFLAGS= -g -O2
-# Get target-specific overrides for TARGET_LIBGCC2_CFLAGS
-# and possibly GNATLIBCFLAGS. Currently this uses files
-# in gcc/config. The 'subst' call is used to rerelativize them
-# from their gcc locations. This is hackery, but there isn't
-# yet a better way to do this.
-tmake_file=$(subst /config,/../gcc/config,$(gcc_tmake_file))
-ifneq ($(tmake_file),)
-include $(tmake_file)
-endif
+include $(GCC_DIR)/libgcc.mvars
+# exeext should not be used because it's the *host* exeext. We're building
+# a *target* library, aren't we?!? Likewise for CC. Still, provide bogus
+# definitions just in case something slips through the safety net provided
+# by recursive make invocations in gcc/ada/Makefile.in
FLAGS_TO_PASS = \
"MAKEOVERRIDES=" \
"LDFLAGS=$(LDFLAGS)" \
"LN_S=$(LN_S)" \
"SHELL=$(SHELL)" \
- "exeext=$(exeext)" \
"objext=$(objext)" \
"prefix=$(prefix)" \
- "CC=$(host_cc_for_libada)" \
+ "exeext=.exeext.should.not.be.used " \
+ 'CC=the.host.compiler.should.not.be.needed' \
"GCC_FOR_TARGET=$(CC)" \
"CFLAGS=$(CFLAGS) $(WARN_CFLAGS)"
diff --git a/libada/configure b/libada/configure
index 1d821c407ea..cafd0f0bda3 100755
--- a/libada/configure
+++ b/libada/configure
@@ -272,7 +272,7 @@ PACKAGE_STRING=
PACKAGE_BUGREPORT=
ac_unique_file="Makefile.in"
-ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os target_noncanonical build_libsubdir build_subdir host_subdir target_subdir MAINT enable_shared LN_S x_ada_cflags default_gnatlib_target LIBOBJS LTLIBOBJS'
+ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os target_noncanonical build_libsubdir build_subdir host_subdir target_subdir MAINT enable_shared LN_S x_ada_cflags default_gnatlib_target CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT warn_cflags LIBOBJS LTLIBOBJS'
ac_subst_files=''
ac_pwd=`pwd`
@@ -714,6 +714,22 @@ ac_env_target_alias_set=${target_alias+set}
ac_env_target_alias_value=$target_alias
ac_cv_env_target_alias_set=${target_alias+set}
ac_cv_env_target_alias_value=$target_alias
+ac_env_CC_set=${CC+set}
+ac_env_CC_value=$CC
+ac_cv_env_CC_set=${CC+set}
+ac_cv_env_CC_value=$CC
+ac_env_CFLAGS_set=${CFLAGS+set}
+ac_env_CFLAGS_value=$CFLAGS
+ac_cv_env_CFLAGS_set=${CFLAGS+set}
+ac_cv_env_CFLAGS_value=$CFLAGS
+ac_env_LDFLAGS_set=${LDFLAGS+set}
+ac_env_LDFLAGS_value=$LDFLAGS
+ac_cv_env_LDFLAGS_set=${LDFLAGS+set}
+ac_cv_env_LDFLAGS_value=$LDFLAGS
+ac_env_CPPFLAGS_set=${CPPFLAGS+set}
+ac_env_CPPFLAGS_value=$CPPFLAGS
+ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set}
+ac_cv_env_CPPFLAGS_value=$CPPFLAGS
#
# Report the --help message.
@@ -799,6 +815,17 @@ Optional Packages:
--without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
--with-build-libsubdir=DIR Directory where to find libraries for build system
+Some influential environment variables:
+ CC C compiler command
+ CFLAGS C compiler flags
+ LDFLAGS linker flags, e.g. -L<lib dir> if you have libraries in a
+ nonstandard directory <lib dir>
+ CPPFLAGS C/C++ preprocessor flags, e.g. -I<include dir> if you have
+ headers in a nonstandard directory <include dir>
+
+Use these variables to override the choices made by `configure' or to help
+it to find libraries and programs with nonstandard names/locations.
+
_ACEOF
fi
@@ -1483,6 +1510,952 @@ else
fi
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}gcc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_CC="${ac_tool_prefix}gcc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$ac_cv_prog_CC"; then
+ ac_ct_CC=$CC
+ # Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_CC"; then
+ ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_CC="gcc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+ echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
+echo "${ECHO_T}$ac_ct_CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ CC=$ac_ct_CC
+else
+ CC="$ac_cv_prog_CC"
+fi
+
+if test -z "$CC"; then
+ if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}cc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_CC="${ac_tool_prefix}cc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$ac_cv_prog_CC"; then
+ ac_ct_CC=$CC
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_CC"; then
+ ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_CC="cc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+ echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
+echo "${ECHO_T}$ac_ct_CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ CC=$ac_ct_CC
+else
+ CC="$ac_cv_prog_CC"
+fi
+
+fi
+if test -z "$CC"; then
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ ac_prog_rejected=no
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# != 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@"
+ fi
+fi
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$CC"; then
+ if test -n "$ac_tool_prefix"; then
+ for ac_prog in cl
+ do
+ # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ test -n "$CC" && break
+ done
+fi
+if test -z "$CC"; then
+ ac_ct_CC=$CC
+ for ac_prog in cl
+do
+ # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_CC"; then
+ ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_CC="$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+ echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
+echo "${ECHO_T}$ac_ct_CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ test -n "$ac_ct_CC" && break
+done
+
+ CC=$ac_ct_CC
+fi
+
+fi
+
+
+test -z "$CC" && { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5
+echo "$as_me: error: in \`$ac_pwd':" >&2;}
+{ { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH
+See \`config.log' for more details." >&5
+echo "$as_me: error: no acceptable C compiler found in \$PATH
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }; }
+
+# Provide some information about the compiler.
+echo "$as_me:$LINENO:" \
+ "checking for C compiler version" >&5
+ac_compiler=`set X $ac_compile; echo $2`
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5
+ (eval $ac_compiler --version </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v </dev/null >&5\"") >&5
+ (eval $ac_compiler -v </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V </dev/null >&5\"") >&5
+ (eval $ac_compiler -V </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files a.out a.exe b.out"
+# Try to create an executable without -o first, disregard a.out.
+# It will help us diagnose broken compilers, and finding out an intuition
+# of exeext.
+echo "$as_me:$LINENO: checking for C compiler default output file name" >&5
+echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6
+ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
+if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5
+ (eval $ac_link_default) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ # Find the output, starting from the most likely. This scheme is
+# not robust to junk in `.', hence go to wildcards (a.*) only as a last
+# resort.
+
+# Be careful to initialize this variable, since it used to be cached.
+# Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile.
+ac_cv_exeext=
+# b.out is created by i960 compilers.
+for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out
+do
+ test -f "$ac_file" || continue
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj )
+ ;;
+ conftest.$ac_ext )
+ # This is the source file.
+ ;;
+ [ab].out )
+ # We found the default executable, but exeext='' is most
+ # certainly right.
+ break;;
+ *.* )
+ ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+ # FIXME: I believe we export ac_cv_exeext for Libtool,
+ # but it would be cool to find out if it's true. Does anybody
+ # maintain Libtool? --akim.
+ export ac_cv_exeext
+ break;;
+ * )
+ break;;
+ esac
+done
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5
+echo "$as_me: error: in \`$ac_pwd':" >&2;}
+{ { echo "$as_me:$LINENO: error: C compiler cannot create executables
+See \`config.log' for more details." >&5
+echo "$as_me: error: C compiler cannot create executables
+See \`config.log' for more details." >&2;}
+ { (exit 77); exit 77; }; }; }
+fi
+
+ac_exeext=$ac_cv_exeext
+echo "$as_me:$LINENO: result: $ac_file" >&5
+echo "${ECHO_T}$ac_file" >&6
+
+# Check the compiler produces executables we can run. If not, either
+# the compiler is broken, or we cross compile.
+echo "$as_me:$LINENO: checking whether the C compiler works" >&5
+echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6
+# FIXME: These cross compiler hacks should be removed for Autoconf 3.0
+# If not cross compiling, check that we can run a simple program.
+if test "$cross_compiling" != yes; then
+ if { ac_try='./$ac_file'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ cross_compiling=no
+ else
+ if test "$cross_compiling" = maybe; then
+ cross_compiling=yes
+ else
+ { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5
+echo "$as_me: error: in \`$ac_pwd':" >&2;}
+{ { echo "$as_me:$LINENO: error: cannot run C compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot run C compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }; }
+ fi
+ fi
+fi
+echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6
+
+rm -f a.out a.exe conftest$ac_cv_exeext b.out
+ac_clean_files=$ac_clean_files_save
+# Check the compiler produces executables we can run. If not, either
+# the compiler is broken, or we cross compile.
+echo "$as_me:$LINENO: checking whether we are cross compiling" >&5
+echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6
+echo "$as_me:$LINENO: result: $cross_compiling" >&5
+echo "${ECHO_T}$cross_compiling" >&6
+
+echo "$as_me:$LINENO: checking for suffix of executables" >&5
+echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ # If both `conftest.exe' and `conftest' are `present' (well, observable)
+# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will
+# work properly (i.e., refer to `conftest.exe'), while it won't with
+# `rm'.
+for ac_file in conftest.exe conftest conftest.*; do
+ test -f "$ac_file" || continue
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;;
+ *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+ export ac_cv_exeext
+ break;;
+ * ) break;;
+ esac
+done
+else
+ { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5
+echo "$as_me: error: in \`$ac_pwd':" >&2;}
+{ { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }; }
+fi
+
+rm -f conftest$ac_cv_exeext
+echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5
+echo "${ECHO_T}$ac_cv_exeext" >&6
+
+rm -f conftest.$ac_ext
+EXEEXT=$ac_cv_exeext
+ac_exeext=$EXEEXT
+echo "$as_me:$LINENO: checking for suffix of object files" >&5
+echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6
+if test "${ac_cv_objext+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.o conftest.obj
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;;
+ *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
+ break;;
+ esac
+done
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5
+echo "$as_me: error: in \`$ac_pwd':" >&2;}
+{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot compute suffix of object files: cannot compile
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }; }
+fi
+
+rm -f conftest.$ac_cv_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_objext" >&5
+echo "${ECHO_T}$ac_cv_objext" >&6
+OBJEXT=$ac_cv_objext
+ac_objext=$OBJEXT
+echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5
+echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6
+if test "${ac_cv_c_compiler_gnu+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+#ifndef __GNUC__
+ choke me
+#endif
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_compiler_gnu=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_compiler_gnu=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_cv_c_compiler_gnu=$ac_compiler_gnu
+
+fi
+echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5
+echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6
+GCC=`test $ac_compiler_gnu = yes && echo yes`
+ac_test_CFLAGS=${CFLAGS+set}
+ac_save_CFLAGS=$CFLAGS
+CFLAGS="-g"
+echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5
+echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6
+if test "${ac_cv_prog_cc_g+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_prog_cc_g=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_prog_cc_g=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5
+echo "${ECHO_T}$ac_cv_prog_cc_g" >&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS=$ac_save_CFLAGS
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5
+echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6
+if test "${ac_cv_prog_cc_stdc+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_cv_prog_cc_stdc=no
+ac_save_CC=$CC
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <stdarg.h>
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */
+struct buf { int x; };
+FILE * (*rcsopen) (struct buf *, struct stat *, int);
+static char *e (p, i)
+ char **p;
+ int i;
+{
+ return p[i];
+}
+static char *f (char * (*g) (char **, int), char **p, ...)
+{
+ char *s;
+ va_list v;
+ va_start (v,p);
+ s = g (p, va_arg (v,int));
+ va_end (v);
+ return s;
+}
+
+/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has
+ function prototypes and stuff, but not '\xHH' hex character constants.
+ These don't provoke an error unfortunately, instead are silently treated
+ as 'x'. The following induces an error, until -std1 is added to get
+ proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an
+ array size at least. It's necessary to write '\x00'==0 to get something
+ that's true only with -std1. */
+int osf4_cc_array ['\x00' == 0 ? 1 : -1];
+
+int test (int i, double x);
+struct s1 {int (*f) (int a);};
+struct s2 {int (*f) (double a);};
+int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
+int argc;
+char **argv;
+int
+main ()
+{
+return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1];
+ ;
+ return 0;
+}
+_ACEOF
+# Don't try gcc -ansi; that turns off useful extensions and
+# breaks some systems' header files.
+# AIX -qlanglvl=ansi
+# Ultrix and OSF/1 -std1
+# HP-UX 10.20 and later -Ae
+# HP-UX older versions -Aa -D_HPUX_SOURCE
+# SVR4 -Xc -D__EXTENSIONS__
+for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
+do
+ CC="$ac_save_CC $ac_arg"
+ rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_prog_cc_stdc=$ac_arg
+break
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+fi
+rm -f conftest.err conftest.$ac_objext
+done
+rm -f conftest.$ac_ext conftest.$ac_objext
+CC=$ac_save_CC
+
+fi
+
+case "x$ac_cv_prog_cc_stdc" in
+ x|xno)
+ echo "$as_me:$LINENO: result: none needed" >&5
+echo "${ECHO_T}none needed" >&6 ;;
+ *)
+ echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5
+echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6
+ CC="$CC $ac_cv_prog_cc_stdc" ;;
+esac
+
+# Some people use a C++ compiler to compile C. Since we use `exit',
+# in C++ we need to declare it. In case someone uses the same compiler
+# for both compiling C and C++ we need to have the C++ compiler decide
+# the declaration of exit, since it's the most demanding environment.
+cat >conftest.$ac_ext <<_ACEOF
+#ifndef __cplusplus
+ choke me
+#endif
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ for ac_declaration in \
+ '' \
+ 'extern "C" void std::exit (int) throw (); using std::exit;' \
+ 'extern "C" void std::exit (int); using std::exit;' \
+ 'extern "C" void exit (int) throw ();' \
+ 'extern "C" void exit (int);' \
+ 'void exit (int);'
+do
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_declaration
+#include <stdlib.h>
+int
+main ()
+{
+exit (42);
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ :
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+continue
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_declaration
+int
+main ()
+{
+exit (42);
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ break
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+done
+rm -f conftest*
+if test -n "$ac_declaration"; then
+ echo '#ifdef __cplusplus' >>confdefs.h
+ echo $ac_declaration >>confdefs.h
+ echo '#endif' >>confdefs.h
+fi
+
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+warn_cflags=
+if test "x$GCC" = "xyes"; then
+ warn_cflags='$(GCC_WARN_CFLAGS)'
+fi
+
+
# Output: create a Makefile.
ac_config_files="$ac_config_files Makefile"
@@ -2143,6 +3116,14 @@ s,@enable_shared@,$enable_shared,;t t
s,@LN_S@,$LN_S,;t t
s,@x_ada_cflags@,$x_ada_cflags,;t t
s,@default_gnatlib_target@,$default_gnatlib_target,;t t
+s,@CC@,$CC,;t t
+s,@CFLAGS@,$CFLAGS,;t t
+s,@LDFLAGS@,$LDFLAGS,;t t
+s,@CPPFLAGS@,$CPPFLAGS,;t t
+s,@ac_ct_CC@,$ac_ct_CC,;t t
+s,@EXEEXT@,$EXEEXT,;t t
+s,@OBJEXT@,$OBJEXT,;t t
+s,@warn_cflags@,$warn_cflags,;t t
s,@LIBOBJS@,$LIBOBJS,;t t
s,@LTLIBOBJS@,$LTLIBOBJS,;t t
CEOF
diff --git a/libada/configure.ac b/libada/configure.ac
index a2668125d8e..b0a46d00332 100644
--- a/libada/configure.ac
+++ b/libada/configure.ac
@@ -73,13 +73,6 @@ AC_SUBST([enable_shared])
# Need to pass this down for now :-P
AC_PROG_LN_S
-# Determine x_ada_cflags
-case $host in
- hppa*) x_ada_cflags=-mdisable-indexing ;;
- *) x_ada_cflags= ;;
-esac
-AC_SUBST([x_ada_cflags])
-
# Determine what to build for 'gnatlib'
if test $build = $target \
&& test ${enable_shared} = yes ; then
@@ -90,6 +83,13 @@ else
fi
AC_SUBST([default_gnatlib_target])
+AC_PROG_CC
+warn_cflags=
+if test "x$GCC" = "xyes"; then
+ warn_cflags='$(GCC_WARN_CFLAGS)'
+fi
+AC_SUBST(warn_cflags)
+
# Output: create a Makefile.
AC_CONFIG_FILES([Makefile])
diff --git a/libcpp/ChangeLog b/libcpp/ChangeLog
index cb1de791edc..49efadc94c6 100644
--- a/libcpp/ChangeLog
+++ b/libcpp/ChangeLog
@@ -1,3 +1,13 @@
+2008-07-31 Jakub Jelinek <jakub@redhat.com>
+
+ PR preprocessor/36649
+ * files.c (struct report_missing_guard_data): New type.
+ (report_missing_guard): Put paths into an array instead of printing
+ them right away. Return 1 rather than 0.
+ (report_missing_guard_cmp): New function.
+ (_cpp_report_missing_guards): Sort and print paths gathered by
+ report_missing_guard callback.
+
2008-07-22 Manuel Lopez-Ibanez <manu@gcc.gnu.org>
PR 28079
diff --git a/libcpp/files.c b/libcpp/files.c
index 1adc58d88a8..007fce77d53 100644
--- a/libcpp/files.c
+++ b/libcpp/files.c
@@ -1221,12 +1221,19 @@ cpp_change_file (cpp_reader *pfile, enum lc_reason reason,
_cpp_do_file_change (pfile, reason, new_name, 1, 0);
}
+struct report_missing_guard_data
+{
+ const char **paths;
+ size_t count;
+};
+
/* Callback function for htab_traverse. */
static int
-report_missing_guard (void **slot, void *b)
+report_missing_guard (void **slot, void *d)
{
struct file_hash_entry *entry = (struct file_hash_entry *) *slot;
- int *bannerp = (int *) b;
+ struct report_missing_guard_data *data
+ = (struct report_missing_guard_data *) d;
/* Skip directories. */
if (entry->start_dir != NULL)
@@ -1236,19 +1243,25 @@ report_missing_guard (void **slot, void *b)
/* We don't want MI guard advice for the main file. */
if (file->cmacro == NULL && file->stack_count == 1 && !file->main_file)
{
- if (*bannerp == 0)
+ if (data->paths == NULL)
{
- fputs (_("Multiple include guards may be useful for:\n"),
- stderr);
- *bannerp = 1;
+ data->paths = XCNEWVEC (const char *, data->count);
+ data->count = 0;
}
- fputs (entry->u.file->path, stderr);
- putc ('\n', stderr);
+ data->paths[data->count++] = file->path;
}
}
- return 0;
+ /* Keep traversing the hash table. */
+ return 1;
+}
+
+/* Comparison function for qsort. */
+static int
+report_missing_guard_cmp (const void *p1, const void *p2)
+{
+ return strcmp (*(const char *const *) p1, *(const char *const *) p2);
}
/* Report on all files that might benefit from a multiple include guard.
@@ -1256,9 +1269,29 @@ report_missing_guard (void **slot, void *b)
void
_cpp_report_missing_guards (cpp_reader *pfile)
{
- int banner = 0;
+ struct report_missing_guard_data data;
+
+ data.paths = NULL;
+ data.count = htab_elements (pfile->file_hash);
+ htab_traverse (pfile->file_hash, report_missing_guard, &data);
- htab_traverse (pfile->file_hash, report_missing_guard, &banner);
+ if (data.paths != NULL)
+ {
+ size_t i;
+
+ /* Sort the paths to avoid outputting them in hash table
+ order. */
+ qsort (data.paths, data.count, sizeof (const char *),
+ report_missing_guard_cmp);
+ fputs (_("Multiple include guards may be useful for:\n"),
+ stderr);
+ for (i = 0; i < data.count; i++)
+ {
+ fputs (data.paths[i], stderr);
+ putc ('\n', stderr);
+ }
+ free (data.paths);
+ }
}
/* Locate HEADER, and determine whether it is newer than the current
diff --git a/libiberty/ChangeLog b/libiberty/ChangeLog
index bf52f9eb491..fa8abf51415 100644
--- a/libiberty/ChangeLog
+++ b/libiberty/ChangeLog
@@ -1,3 +1,15 @@
+2008-07-31 Jakub Jelinek <jakub@redhat.com>
+
+ * mkstemps.c (mkstemps): Keep looping even for EISDIR.
+
+2008-07-31 Denys Vlasenko <dvlasenk@redhat.com>
+
+ * mkstemps.c (mkstemps): If open failed with errno other than
+ EEXIST, return immediately.
+ * make-temp-file.c: Include errno.h.
+ (make_temp_file): If mkstemps failed, print an error message
+ before aborting.
+
2008-07-24 Ralf Wildenhues <Ralf.Wildenhues@gmx.de>
* maint-tool (deps): Output config.h instead of stamp-h.
diff --git a/libiberty/make-temp-file.c b/libiberty/make-temp-file.c
index 5e21414ad8e..94c76d700bd 100644
--- a/libiberty/make-temp-file.c
+++ b/libiberty/make-temp-file.c
@@ -23,6 +23,7 @@ Boston, MA 02110-1301, USA. */
#include <stdio.h> /* May get P_tmpdir. */
#include <sys/types.h>
+#include <errno.h>
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
@@ -166,11 +167,14 @@ make_temp_file (const char *suffix)
strcpy (temp_filename + base_len + TEMP_FILE_LEN, suffix);
fd = mkstemps (temp_filename, suffix_len);
- /* If mkstemps failed, then something bad is happening. Maybe we should
- issue a message about a possible security attack in progress? */
+ /* Mkstemps failed. It may be EPERM, ENOSPC etc. */
if (fd == -1)
- abort ();
- /* Similarly if we can not close the file. */
+ {
+ fprintf (stderr, "Cannot create temporary file in %s: %s\n",
+ base, strerror (errno));
+ abort ();
+ }
+ /* We abort on failed close out of sheer paranoia. */
if (close (fd))
abort ();
return temp_filename;
diff --git a/libiberty/mkstemps.c b/libiberty/mkstemps.c
index 6c2e472528b..a0e68a73b49 100644
--- a/libiberty/mkstemps.c
+++ b/libiberty/mkstemps.c
@@ -127,6 +127,13 @@ mkstemps (char *pattern, int suffix_len)
if (fd >= 0)
/* The file does not exist. */
return fd;
+ if (errno != EEXIST
+#ifdef EISDIR
+ && errno != EISDIR
+#endif
+ )
+ /* Fatal error (EPERM, ENOSPC etc). Doesn't make sense to loop. */
+ break;
/* This is a random value. It is only necessary that the next
TMP_MAX values generated by adding 7777 to VALUE are different
diff --git a/libstdc++-v3/ChangeLog b/libstdc++-v3/ChangeLog
index 8c90e3a99cc..be834051e0d 100644
--- a/libstdc++-v3/ChangeLog
+++ b/libstdc++-v3/ChangeLog
@@ -1,3 +1,33 @@
+2008-08-01 Paolo Bonzini <bonzini@gnu.org>
+ Chris Fairles <chris.fairles@gmail.com>
+
+ * acinclude.m4 ([GLIBCXX_CHECK_CLOCK_GETTIME]): Reinstate clock_gettime
+ search, but only in libposix4, never link librt.
+ * src/Makefile.am: Reinstate previous change to add GLIBCXX_LIBS.
+ * configure: Regenerate.
+ * configure.in: Likewise.
+ * Makefile.in: Likewise.
+ * src/Makefile.in: Likewise.
+ * libsup++/Makefile.in: Likewise.
+ * po/Makefile.in: Likewise.
+ * doc/Makefile.in: Likewise.
+
+2008-07-31 Chris Fairles <chris.fairles@gmail.com>
+
+ * include/std/chrono (duration): Use explicitly defaulted ctor, cctor,
+ dtor and assignment. Add diagnostics as per 20.8.3 paragraphs 2, 3
+ and 4 in WD. Other minor tweaks.
+ * testsuite/20_util/duration/cons/1_neg.cc: Adjust line numbers.
+ * testsuite/20_util/duration/requirements/typedefs_neg1.cc: New.
+ * testsuite/20_util/duration/requirements/typedefs_neg2.cc: Likewise.
+ * testsuite/20_util/duration/requirements/typedefs_neg3.cc: Likewise.
+
+2008-07-31 Paolo Carlini <paolo.carlini@oracle.com>
+
+ * testsuite/lib/libstdc++.exp (libstdc++_init): Set v3-libgomp.
+ (check_v3_target_parallel_mode): Robustify, just follow the
+ structure of testsuite/Makefile.am.
+
2008-07-29 Paolo Carlini <paolo.carlini@oracle.com>
* include/debug/set.h: Minor formatting fixes.
diff --git a/libstdc++-v3/Makefile.in b/libstdc++-v3/Makefile.in
index 4835d08349f..f4e4a414b88 100644
--- a/libstdc++-v3/Makefile.in
+++ b/libstdc++-v3/Makefile.in
@@ -180,6 +180,7 @@ GLIBCXX_HOSTED_TRUE = @GLIBCXX_HOSTED_TRUE@
GLIBCXX_INCLUDES = @GLIBCXX_INCLUDES@
GLIBCXX_LDBL_COMPAT_FALSE = @GLIBCXX_LDBL_COMPAT_FALSE@
GLIBCXX_LDBL_COMPAT_TRUE = @GLIBCXX_LDBL_COMPAT_TRUE@
+GLIBCXX_LIBS = @GLIBCXX_LIBS@
GREP = @GREP@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
diff --git a/libstdc++-v3/acinclude.m4 b/libstdc++-v3/acinclude.m4
index e998471c446..0a669c9a7fa 100644
--- a/libstdc++-v3/acinclude.m4
+++ b/libstdc++-v3/acinclude.m4
@@ -1018,7 +1018,15 @@ AC_DEFUN([GLIBCXX_CHECK_CLOCK_GETTIME], [
AC_LANG_CPLUSPLUS
ac_save_CXXFLAGS="$CXXFLAGS"
CXXFLAGS="$CXXFLAGS -fno-exceptions"
-
+ ac_save_LIBS="$LIBS"
+
+ AC_SEARCH_LIBS(clock_gettime, [posix4])
+
+ # Link to -lposix4.
+ case "$ac_cv_search_clock_gettime" in
+ -lposix4*) GLIBCXX_LIBS=$ac_cv_search_clock_gettime
+ esac
+
AC_CHECK_HEADERS(unistd.h, ac_has_unistd_h=yes, ac_has_unistd_h=no)
ac_has_clock_monotonic=no;
@@ -1055,13 +1063,16 @@ AC_DEFUN([GLIBCXX_CHECK_CLOCK_GETTIME], [
AC_DEFINE(_GLIBCXX_USE_CLOCK_MONOTONIC, 1,
[ Defined if clock_gettime has monotonic clock support. ])
fi
-
+
if test x"$ac_has_clock_realtime" = x"yes"; then
AC_DEFINE(_GLIBCXX_USE_CLOCK_REALTIME, 1,
[ Defined if clock_gettime has realtime clock support. ])
fi
-
+
+ AC_SUBST(GLIBCXX_LIBS)
+
CXXFLAGS="$ac_save_CXXFLAGS"
+ LIBS="$ac_save_LIBS"
AC_LANG_RESTORE
])
diff --git a/libstdc++-v3/configure b/libstdc++-v3/configure
index 901a2dc1e4f..2ea940ae8a1 100755
--- a/libstdc++-v3/configure
+++ b/libstdc++-v3/configure
@@ -458,7 +458,7 @@ ac_includes_default="\
# include <unistd.h>
#endif"
-ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS libtool_VERSION multi_basedir build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA CYGPATH_W PACKAGE VERSION ACLOCAL AUTOCONF AUTOMAKE AUTOHEADER MAKEINFO install_sh STRIP ac_ct_STRIP INSTALL_STRIP_PROGRAM mkdir_p AWK SET_MAKE am__leading_dot AMTAR am__tar am__untar glibcxx_builddir glibcxx_srcdir toplevel_srcdir CC ac_ct_CC EXEEXT OBJEXT CXX ac_ct_CXX CFLAGS CXXFLAGS LN_S AS ac_ct_AS AR ac_ct_AR RANLIB ac_ct_RANLIB MAINTAINER_MODE_TRUE MAINTAINER_MODE_FALSE MAINT CPP CPPFLAGS EGREP LIBTOOL SED FGREP GREP LD DUMPBIN ac_ct_DUMPBIN NM lt_ECHO LDFLAGS CXXCPP enable_shared enable_static GLIBCXX_HOSTED_TRUE GLIBCXX_HOSTED_FALSE GLIBCXX_BUILD_PCH_TRUE GLIBCXX_BUILD_PCH_FALSE glibcxx_PCHFLAGS glibcxx_thread_h WERROR SECTION_FLAGS CSTDIO_H BASIC_FILE_H BASIC_FILE_CC check_msgfmt glibcxx_MOFILES glibcxx_POFILES glibcxx_localedir USE_NLS CLOCALE_H CMESSAGES_H CCODECVT_CC CCOLLATE_CC CCTYPE_CC CMESSAGES_CC CMONEY_CC CNUMERIC_CC CTIME_H CTIME_CC CLOCALE_CC CLOCALE_INTERNAL_H ALLOCATOR_H ALLOCATOR_NAME C_INCLUDE_DIR GLIBCXX_C_HEADERS_C_TRUE GLIBCXX_C_HEADERS_C_FALSE GLIBCXX_C_HEADERS_C_STD_TRUE GLIBCXX_C_HEADERS_C_STD_FALSE GLIBCXX_C_HEADERS_C_GLOBAL_TRUE GLIBCXX_C_HEADERS_C_GLOBAL_FALSE GLIBCXX_C_HEADERS_COMPATIBILITY_TRUE GLIBCXX_C_HEADERS_COMPATIBILITY_FALSE GLIBCXX_C_HEADERS_EXTRA_TRUE GLIBCXX_C_HEADERS_EXTRA_FALSE DEBUG_FLAGS GLIBCXX_BUILD_DEBUG_TRUE GLIBCXX_BUILD_DEBUG_FALSE ENABLE_PARALLEL_TRUE ENABLE_PARALLEL_FALSE EXTRA_CXX_FLAGS SECTION_LDFLAGS OPT_LDFLAGS LIBMATHOBJS LIBICONV LTLIBICONV SYMVER_FILE port_specific_symbol_files ENABLE_SYMVERS_TRUE ENABLE_SYMVERS_FALSE ENABLE_SYMVERS_GNU_TRUE ENABLE_SYMVERS_GNU_FALSE ENABLE_SYMVERS_GNU_NAMESPACE_TRUE ENABLE_SYMVERS_GNU_NAMESPACE_FALSE ENABLE_SYMVERS_DARWIN_TRUE ENABLE_SYMVERS_DARWIN_FALSE ENABLE_VISIBILITY_TRUE ENABLE_VISIBILITY_FALSE GLIBCXX_LDBL_COMPAT_TRUE GLIBCXX_LDBL_COMPAT_FALSE baseline_dir ATOMICITY_SRCDIR ATOMIC_WORD_SRCDIR ATOMIC_FLAGS CPU_DEFINES_SRCDIR ABI_TWEAKS_SRCDIR OS_INC_SRCDIR ERROR_CONSTANTS_SRCDIR glibcxx_prefixdir gxx_include_dir glibcxx_toolexecdir glibcxx_toolexeclibdir GLIBCXX_INCLUDES TOPLEVEL_INCLUDES OPTIMIZE_CXXFLAGS WARN_FLAGS LIBSUPCXX_PICFLAGS LIBOBJS LTLIBOBJS'
+ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS libtool_VERSION multi_basedir build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA CYGPATH_W PACKAGE VERSION ACLOCAL AUTOCONF AUTOMAKE AUTOHEADER MAKEINFO install_sh STRIP ac_ct_STRIP INSTALL_STRIP_PROGRAM mkdir_p AWK SET_MAKE am__leading_dot AMTAR am__tar am__untar glibcxx_builddir glibcxx_srcdir toplevel_srcdir CC ac_ct_CC EXEEXT OBJEXT CXX ac_ct_CXX CFLAGS CXXFLAGS LN_S AS ac_ct_AS AR ac_ct_AR RANLIB ac_ct_RANLIB MAINTAINER_MODE_TRUE MAINTAINER_MODE_FALSE MAINT CPP CPPFLAGS EGREP LIBTOOL SED FGREP GREP LD DUMPBIN ac_ct_DUMPBIN NM lt_ECHO LDFLAGS CXXCPP enable_shared enable_static GLIBCXX_HOSTED_TRUE GLIBCXX_HOSTED_FALSE GLIBCXX_BUILD_PCH_TRUE GLIBCXX_BUILD_PCH_FALSE glibcxx_PCHFLAGS glibcxx_thread_h WERROR SECTION_FLAGS CSTDIO_H BASIC_FILE_H BASIC_FILE_CC check_msgfmt glibcxx_MOFILES glibcxx_POFILES glibcxx_localedir USE_NLS CLOCALE_H CMESSAGES_H CCODECVT_CC CCOLLATE_CC CCTYPE_CC CMESSAGES_CC CMONEY_CC CNUMERIC_CC CTIME_H CTIME_CC CLOCALE_CC CLOCALE_INTERNAL_H ALLOCATOR_H ALLOCATOR_NAME C_INCLUDE_DIR GLIBCXX_C_HEADERS_C_TRUE GLIBCXX_C_HEADERS_C_FALSE GLIBCXX_C_HEADERS_C_STD_TRUE GLIBCXX_C_HEADERS_C_STD_FALSE GLIBCXX_C_HEADERS_C_GLOBAL_TRUE GLIBCXX_C_HEADERS_C_GLOBAL_FALSE GLIBCXX_C_HEADERS_COMPATIBILITY_TRUE GLIBCXX_C_HEADERS_COMPATIBILITY_FALSE GLIBCXX_C_HEADERS_EXTRA_TRUE GLIBCXX_C_HEADERS_EXTRA_FALSE DEBUG_FLAGS GLIBCXX_BUILD_DEBUG_TRUE GLIBCXX_BUILD_DEBUG_FALSE ENABLE_PARALLEL_TRUE ENABLE_PARALLEL_FALSE EXTRA_CXX_FLAGS SECTION_LDFLAGS OPT_LDFLAGS LIBMATHOBJS GLIBCXX_LIBS LIBICONV LTLIBICONV SYMVER_FILE port_specific_symbol_files ENABLE_SYMVERS_TRUE ENABLE_SYMVERS_FALSE ENABLE_SYMVERS_GNU_TRUE ENABLE_SYMVERS_GNU_FALSE ENABLE_SYMVERS_GNU_NAMESPACE_TRUE ENABLE_SYMVERS_GNU_NAMESPACE_FALSE ENABLE_SYMVERS_DARWIN_TRUE ENABLE_SYMVERS_DARWIN_FALSE ENABLE_VISIBILITY_TRUE ENABLE_VISIBILITY_FALSE GLIBCXX_LDBL_COMPAT_TRUE GLIBCXX_LDBL_COMPAT_FALSE baseline_dir ATOMICITY_SRCDIR ATOMIC_WORD_SRCDIR ATOMIC_FLAGS CPU_DEFINES_SRCDIR ABI_TWEAKS_SRCDIR OS_INC_SRCDIR ERROR_CONSTANTS_SRCDIR glibcxx_prefixdir gxx_include_dir glibcxx_toolexecdir glibcxx_toolexeclibdir GLIBCXX_INCLUDES TOPLEVEL_INCLUDES OPTIMIZE_CXXFLAGS WARN_FLAGS LIBSUPCXX_PICFLAGS LIBOBJS LTLIBOBJS'
ac_subst_files=''
ac_pwd=`pwd`
@@ -40960,6 +40960,149 @@ ac_compiler_gnu=$ac_cv_cxx_compiler_gnu
ac_save_CXXFLAGS="$CXXFLAGS"
CXXFLAGS="$CXXFLAGS -fno-exceptions"
+ ac_save_LIBS="$LIBS"
+
+ echo "$as_me:$LINENO: checking for library containing clock_gettime" >&5
+echo $ECHO_N "checking for library containing clock_gettime... $ECHO_C" >&6
+if test "${ac_cv_search_clock_gettime+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_func_search_save_LIBS=$LIBS
+ac_cv_search_clock_gettime=no
+if test x$gcc_no_link = xyes; then
+ { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5
+echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char clock_gettime ();
+int
+main ()
+{
+clock_gettime ();
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_cxx_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_search_clock_gettime="none required"
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+fi
+rm -f conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+if test "$ac_cv_search_clock_gettime" = no; then
+ for ac_lib in posix4; do
+ LIBS="-l$ac_lib $ac_func_search_save_LIBS"
+ if test x$gcc_no_link = xyes; then
+ { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5
+echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char clock_gettime ();
+int
+main ()
+{
+clock_gettime ();
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_cxx_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_search_clock_gettime="-l$ac_lib"
+break
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+fi
+rm -f conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+ done
+fi
+LIBS=$ac_func_search_save_LIBS
+fi
+echo "$as_me:$LINENO: result: $ac_cv_search_clock_gettime" >&5
+echo "${ECHO_T}$ac_cv_search_clock_gettime" >&6
+if test "$ac_cv_search_clock_gettime" != no; then
+ test "$ac_cv_search_clock_gettime" = "none required" || LIBS="$ac_cv_search_clock_gettime $LIBS"
+
+fi
+
+
+ # Link to -lposix4.
+ case "$ac_cv_search_clock_gettime" in
+ -lposix4*) GLIBCXX_LIBS=$ac_cv_search_clock_gettime
+ esac
for ac_header in unistd.h
@@ -41260,7 +41403,10 @@ _ACEOF
fi
+
+
CXXFLAGS="$ac_save_CXXFLAGS"
+ LIBS="$ac_save_LIBS"
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
@@ -122537,6 +122683,7 @@ s,@EXTRA_CXX_FLAGS@,$EXTRA_CXX_FLAGS,;t t
s,@SECTION_LDFLAGS@,$SECTION_LDFLAGS,;t t
s,@OPT_LDFLAGS@,$OPT_LDFLAGS,;t t
s,@LIBMATHOBJS@,$LIBMATHOBJS,;t t
+s,@GLIBCXX_LIBS@,$GLIBCXX_LIBS,;t t
s,@LIBICONV@,$LIBICONV,;t t
s,@LTLIBICONV@,$LTLIBICONV,;t t
s,@SYMVER_FILE@,$SYMVER_FILE,;t t
diff --git a/libstdc++-v3/doc/Makefile.in b/libstdc++-v3/doc/Makefile.in
index 7ffe5766ce1..a5c842f2ce8 100644
--- a/libstdc++-v3/doc/Makefile.in
+++ b/libstdc++-v3/doc/Makefile.in
@@ -148,6 +148,7 @@ GLIBCXX_HOSTED_TRUE = @GLIBCXX_HOSTED_TRUE@
GLIBCXX_INCLUDES = @GLIBCXX_INCLUDES@
GLIBCXX_LDBL_COMPAT_FALSE = @GLIBCXX_LDBL_COMPAT_FALSE@
GLIBCXX_LDBL_COMPAT_TRUE = @GLIBCXX_LDBL_COMPAT_TRUE@
+GLIBCXX_LIBS = @GLIBCXX_LIBS@
GREP = @GREP@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
diff --git a/libstdc++-v3/include/Makefile.in b/libstdc++-v3/include/Makefile.in
index cb529671e3a..2c5d744fd4f 100644
--- a/libstdc++-v3/include/Makefile.in
+++ b/libstdc++-v3/include/Makefile.in
@@ -148,6 +148,7 @@ GLIBCXX_HOSTED_TRUE = @GLIBCXX_HOSTED_TRUE@
GLIBCXX_INCLUDES = @GLIBCXX_INCLUDES@
GLIBCXX_LDBL_COMPAT_FALSE = @GLIBCXX_LDBL_COMPAT_FALSE@
GLIBCXX_LDBL_COMPAT_TRUE = @GLIBCXX_LDBL_COMPAT_TRUE@
+GLIBCXX_LIBS = @GLIBCXX_LIBS@
GREP = @GREP@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
diff --git a/libstdc++-v3/include/std/chrono b/libstdc++-v3/include/std/chrono
index b5fd1fd209e..d20c7f45cd9 100644
--- a/libstdc++-v3/include/std/chrono
+++ b/libstdc++-v3/include/std/chrono
@@ -166,36 +166,51 @@ namespace std
{ return numeric_limits<_Rep>::min(); }
};
+ template<typename _Tp>
+ struct __is_duration
+ : std::false_type
+ { };
+
+ template<typename _Rep, typename _Period>
+ struct __is_duration<duration<_Rep, _Period>>
+ : std::true_type
+ { };
+
+ template<typename T>
+ struct __is_ratio
+ : std::false_type
+ { };
+
+ template<intmax_t _Num, intmax_t _Den>
+ struct __is_ratio<ratio<_Num, _Den>>
+ : std::true_type
+ { };
+
/// duration
template<typename _Rep, typename _Period>
struct duration
{
+ static_assert(!__is_duration<_Rep>::value, "rep cannot be a duration");
+ static_assert(__is_ratio<_Period>::value,
+ "period must be a specialization of ratio");
static_assert(_Period::num > 0, "period must be positive");
typedef _Rep rep;
typedef _Period period;
- // construction / destruction
- duration ()
- : __r(rep(0))
- { }
+ // 20.8.3.1 construction / copy / destroy
+ duration() = default;
template<typename _Rep2>
explicit duration(_Rep2 const& __rep)
: __r(static_cast<rep>(__rep))
{
- static_assert(is_convertible<_Rep2,rep>::value == true
- && (treat_as_floating_point<rep>::value == true
- || (!treat_as_floating_point<rep>::value
- && !treat_as_floating_point<_Rep2>::value)),
- "cannot construct integral duration with floating point type");
+ static_assert(is_convertible<_Rep2,rep>::value
+ && (treat_as_floating_point<rep>::value
+ || !treat_as_floating_point<_Rep2>::value),
+ "cannot construct integral duration with floating point type");
}
- duration(const duration& __d)
- : __r(__d.count())
- { }
-
- // conversions
template<typename _Rep2, typename _Period2>
duration(const duration<_Rep2, _Period2>& __d)
: __r(duration_cast<duration>(__d).count())
@@ -205,12 +220,16 @@ namespace std
"the resulting duration is not exactly representable");
}
- // observer
+ ~duration() = default;
+ duration(const duration&) = default;
+ duration& operator=(const duration&) = default;
+
+ // 20.8.3.2 observer
rep
count() const
{ return __r; }
- // arithmetic
+ // 20.8.3.3 arithmetic
duration
operator+() const
{ return *this; }
@@ -269,7 +288,7 @@ namespace std
return *this;
}
- // special values
+ // 20.8.3.4 special values
// TODO: These should be constexprs.
static const duration
zero()
@@ -324,22 +343,12 @@ namespace std
operator*(const _Rep2& __s, const duration<_Rep1, _Period>& __d)
{ return __d * __s; }
- template<typename _Tp>
- struct __is_not_duration
- : std::true_type
- { };
-
- template<typename _Rep, typename _Period>
- struct __is_not_duration<duration<_Rep, _Period>>
- : std::false_type
- { };
-
template<typename _Tp, typename _Up, typename _Ep = void>
struct __division_impl;
template<typename _Rep1, typename _Period, typename _Rep2>
struct __division_impl<duration<_Rep1, _Period>, _Rep2,
- typename enable_if<__is_not_duration<_Rep2>::value>::type>
+ typename enable_if<!__is_duration<_Rep2>::value>::type>
{
typedef typename common_type<_Rep1, _Rep2>::type __cr;
typedef
diff --git a/libstdc++-v3/libmath/Makefile.in b/libstdc++-v3/libmath/Makefile.in
index 1db093b15cc..1592897335e 100644
--- a/libstdc++-v3/libmath/Makefile.in
+++ b/libstdc++-v3/libmath/Makefile.in
@@ -163,6 +163,7 @@ GLIBCXX_HOSTED_TRUE = @GLIBCXX_HOSTED_TRUE@
GLIBCXX_INCLUDES = @GLIBCXX_INCLUDES@
GLIBCXX_LDBL_COMPAT_FALSE = @GLIBCXX_LDBL_COMPAT_FALSE@
GLIBCXX_LDBL_COMPAT_TRUE = @GLIBCXX_LDBL_COMPAT_TRUE@
+GLIBCXX_LIBS = @GLIBCXX_LIBS@
GREP = @GREP@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
diff --git a/libstdc++-v3/libsupc++/Makefile.in b/libstdc++-v3/libsupc++/Makefile.in
index 0f7cf8c517e..105aec63d8d 100644
--- a/libstdc++-v3/libsupc++/Makefile.in
+++ b/libstdc++-v3/libsupc++/Makefile.in
@@ -218,6 +218,7 @@ GLIBCXX_HOSTED_TRUE = @GLIBCXX_HOSTED_TRUE@
GLIBCXX_INCLUDES = @GLIBCXX_INCLUDES@
GLIBCXX_LDBL_COMPAT_FALSE = @GLIBCXX_LDBL_COMPAT_FALSE@
GLIBCXX_LDBL_COMPAT_TRUE = @GLIBCXX_LDBL_COMPAT_TRUE@
+GLIBCXX_LIBS = @GLIBCXX_LIBS@
GREP = @GREP@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
diff --git a/libstdc++-v3/po/Makefile.in b/libstdc++-v3/po/Makefile.in
index c79788dac38..b19c1b4d94b 100644
--- a/libstdc++-v3/po/Makefile.in
+++ b/libstdc++-v3/po/Makefile.in
@@ -148,6 +148,7 @@ GLIBCXX_HOSTED_TRUE = @GLIBCXX_HOSTED_TRUE@
GLIBCXX_INCLUDES = @GLIBCXX_INCLUDES@
GLIBCXX_LDBL_COMPAT_FALSE = @GLIBCXX_LDBL_COMPAT_FALSE@
GLIBCXX_LDBL_COMPAT_TRUE = @GLIBCXX_LDBL_COMPAT_TRUE@
+GLIBCXX_LIBS = @GLIBCXX_LIBS@
GREP = @GREP@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
diff --git a/libstdc++-v3/src/Makefile.am b/libstdc++-v3/src/Makefile.am
index 6ea357f2ce9..cf4522fe28a 100644
--- a/libstdc++-v3/src/Makefile.am
+++ b/libstdc++-v3/src/Makefile.am
@@ -196,10 +196,14 @@ vpath % $(top_srcdir)
libstdc___la_SOURCES = $(sources)
libstdc___la_LIBADD = \
+ $(GLIBCXX_LIBS) \
$(top_builddir)/libmath/libmath.la \
$(top_builddir)/libsupc++/libsupc++convenience.la
-libstdc___la_DEPENDENCIES = ${version_dep} $(libstdc___la_LIBADD)
+libstdc___la_DEPENDENCIES = \
+ ${version_dep} \
+ $(top_builddir)/libmath/libmath.la \
+ $(top_builddir)/libsupc++/libsupc++convenience.la
libstdc___la_LDFLAGS = \
-version-info $(libtool_VERSION) ${version_arg} -lm
diff --git a/libstdc++-v3/src/Makefile.in b/libstdc++-v3/src/Makefile.in
index b674061d3a8..6c2030a845e 100644
--- a/libstdc++-v3/src/Makefile.in
+++ b/libstdc++-v3/src/Makefile.in
@@ -72,6 +72,7 @@ am__strip_dir = `echo $$p | sed -e 's|^.*/||'`;
am__installdirs = "$(DESTDIR)$(toolexeclibdir)"
toolexeclibLTLIBRARIES_INSTALL = $(INSTALL)
LTLIBRARIES = $(toolexeclib_LTLIBRARIES)
+am__DEPENDENCIES_1 =
am__libstdc___la_SOURCES_DIST = atomic.cc bitmap_allocator.cc \
pool_allocator.cc mt_allocator.cc codecvt.cc compatibility.cc \
complex_io.cc ctype.cc debug.cc functexcept.cc hash.cc \
@@ -205,6 +206,7 @@ GLIBCXX_HOSTED_TRUE = @GLIBCXX_HOSTED_TRUE@
GLIBCXX_INCLUDES = @GLIBCXX_INCLUDES@
GLIBCXX_LDBL_COMPAT_FALSE = @GLIBCXX_LDBL_COMPAT_FALSE@
GLIBCXX_LDBL_COMPAT_TRUE = @GLIBCXX_LDBL_COMPAT_TRUE@
+GLIBCXX_LIBS = @GLIBCXX_LIBS@
GREP = @GREP@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
@@ -428,10 +430,15 @@ sources = \
libstdc___la_SOURCES = $(sources)
libstdc___la_LIBADD = \
+ $(GLIBCXX_LIBS) \
+ $(top_builddir)/libmath/libmath.la \
+ $(top_builddir)/libsupc++/libsupc++convenience.la
+
+libstdc___la_DEPENDENCIES = \
+ ${version_dep} \
$(top_builddir)/libmath/libmath.la \
$(top_builddir)/libsupc++/libsupc++convenience.la
-libstdc___la_DEPENDENCIES = ${version_dep} $(libstdc___la_LIBADD)
libstdc___la_LDFLAGS = \
-version-info $(libtool_VERSION) ${version_arg} -lm
diff --git a/libstdc++-v3/testsuite/20_util/duration/cons/1_neg.cc b/libstdc++-v3/testsuite/20_util/duration/cons/1_neg.cc
index fa63dab22b5..d8b08dbd4f8 100644
--- a/libstdc++-v3/testsuite/20_util/duration/cons/1_neg.cc
+++ b/libstdc++-v3/testsuite/20_util/duration/cons/1_neg.cc
@@ -41,6 +41,6 @@ test02()
// { dg-error "instantiated from here" "" { target *-*-* } 30 }
// { dg-error "instantiated from here" "" { target *-*-* } 39 }
-// { dg-error "not exactly representable" "" { target *-*-* } 203 }
-// { dg-error "integral duration with floating point" "" { target *-*-* } 187 }
+// { dg-error "not exactly representable" "" { target *-*-* } 218 }
+// { dg-error "integral duration with floating point" "" { target *-*-* } 208 }
// { dg-excess-errors "In instantiation of" }
diff --git a/libstdc++-v3/testsuite/20_util/duration/requirements/typedefs_neg1.cc b/libstdc++-v3/testsuite/20_util/duration/requirements/typedefs_neg1.cc
new file mode 100644
index 00000000000..188950d6347
--- /dev/null
+++ b/libstdc++-v3/testsuite/20_util/duration/requirements/typedefs_neg1.cc
@@ -0,0 +1,45 @@
+// { dg-do compile }
+// { dg-options "-std=gnu++0x" }
+// { dg-require-cstdint "" }
+// 2008-07-31 Chris Fairles <chris.fairles@gmail.com>
+
+// Copyright (C) 2008 Free Software Foundation, Inc.
+//
+// This file is part of the GNU ISO C++ Library. This library 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 version.
+
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or 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 this library; see the file COPYING. If not, write to the Free
+// Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+// USA.
+
+// As a special exception, you may use this file as part of a free software
+// library without restriction. Specifically, if other files instantiate
+// templates or use macros or inline functions from this file, or you compile
+// this file and link it with other files to produce an executable, this
+// file does not by itself cause the resulting executable to be covered by
+// the GNU General Public License. This exception does not however
+// invalidate any other reasons why the executable file might be covered by
+// the GNU General Public License.
+
+#include <chrono>
+
+void test01()
+{
+ // Check if rep is a duration type
+ typedef std::chrono::duration<int> rep_type;
+ typedef std::chrono::duration<rep_type> test_type;
+ test_type d;
+}
+
+// { dg-error "rep cannot be a duration" "" { target *-*-* } 193 }
+// { dg-error "instantiated from here" "" { target *-*-* } 40 }
+// { dg-excess-errors "In instantiation of" }
diff --git a/libstdc++-v3/testsuite/20_util/duration/requirements/typedefs_neg2.cc b/libstdc++-v3/testsuite/20_util/duration/requirements/typedefs_neg2.cc
new file mode 100644
index 00000000000..783044fada6
--- /dev/null
+++ b/libstdc++-v3/testsuite/20_util/duration/requirements/typedefs_neg2.cc
@@ -0,0 +1,46 @@
+// { dg-do compile }
+// { dg-options "-std=gnu++0x" }
+// { dg-require-cstdint "" }
+// 2008-07-31 Chris Fairles <chris.fairles@gmail.com>
+
+// Copyright (C) 2008 Free Software Foundation, Inc.
+//
+// This file is part of the GNU ISO C++ Library. This library 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 version.
+
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or 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 this library; see the file COPYING. If not, write to the Free
+// Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+// USA.
+
+// As a special exception, you may use this file as part of a free software
+// library without restriction. Specifically, if other files instantiate
+// templates or use macros or inline functions from this file, or you compile
+// this file and link it with other files to produce an executable, this
+// file does not by itself cause the resulting executable to be covered by
+// the GNU General Public License. This exception does not however
+// invalidate any other reasons why the executable file might be covered by
+// the GNU General Public License.
+
+#include <chrono>
+
+void test01()
+{
+ // Check if period is a ratio
+ typedef int rep_type;
+ typedef int period_type;
+ typedef std::chrono::duration<rep_type, period_type> test_type;
+ test_type d;
+}
+
+// { dg-error "must be a specialization of ratio" "" { target *-*-* } 194 }
+// { dg-error "instantiated from here" "" { target *-*-* } 41 }
+// { dg-excess-errors "In instantiation of" }
diff --git a/libstdc++-v3/testsuite/20_util/duration/requirements/typedefs_neg3.cc b/libstdc++-v3/testsuite/20_util/duration/requirements/typedefs_neg3.cc
new file mode 100644
index 00000000000..2896845d7d2
--- /dev/null
+++ b/libstdc++-v3/testsuite/20_util/duration/requirements/typedefs_neg3.cc
@@ -0,0 +1,47 @@
+// { dg-do compile }
+// { dg-options "-std=gnu++0x" }
+// { dg-require-cstdint "" }
+// 2008-07-31 Chris Fairles <chris.fairles@gmail.com>
+
+// Copyright (C) 2008 Free Software Foundation, Inc.
+//
+// This file is part of the GNU ISO C++ Library. This library 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 version.
+
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or 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 this library; see the file COPYING. If not, write to the Free
+// Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+// USA.
+
+// As a special exception, you may use this file as part of a free software
+// library without restriction. Specifically, if other files instantiate
+// templates or use macros or inline functions from this file, or you compile
+// this file and link it with other files to produce an executable, this
+// file does not by itself cause the resulting executable to be covered by
+// the GNU General Public License. This exception does not however
+// invalidate any other reasons why the executable file might be covered by
+// the GNU General Public License.
+
+#include <ratio>
+#include <chrono>
+
+void test01()
+{
+ // Check if period is positive
+ typedef int rep_type;
+ typedef std::ratio<-1> period_type;
+ typedef std::chrono::duration<rep_type, period_type> test_type;
+ test_type d;
+}
+
+// { dg-error "period must be positive" "" { target *-*-* } 196 }
+// { dg-error "instantiated from here" "" { target *-*-* } 42 }
+// { dg-excess-errors "In instantiation of" }
diff --git a/libstdc++-v3/testsuite/Makefile.in b/libstdc++-v3/testsuite/Makefile.in
index c029ced7612..4bd6419a506 100644
--- a/libstdc++-v3/testsuite/Makefile.in
+++ b/libstdc++-v3/testsuite/Makefile.in
@@ -152,6 +152,7 @@ GLIBCXX_HOSTED_TRUE = @GLIBCXX_HOSTED_TRUE@
GLIBCXX_INCLUDES = @GLIBCXX_INCLUDES@
GLIBCXX_LDBL_COMPAT_FALSE = @GLIBCXX_LDBL_COMPAT_FALSE@
GLIBCXX_LDBL_COMPAT_TRUE = @GLIBCXX_LDBL_COMPAT_TRUE@
+GLIBCXX_LIBS = @GLIBCXX_LIBS@
GREP = @GREP@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
diff --git a/libstdc++-v3/testsuite/lib/libstdc++.exp b/libstdc++-v3/testsuite/lib/libstdc++.exp
index afcaa19d136..9412ce976ad 100644
--- a/libstdc++-v3/testsuite/lib/libstdc++.exp
+++ b/libstdc++-v3/testsuite/lib/libstdc++.exp
@@ -81,7 +81,7 @@ proc v3-copy-files {srcfiles} {
# Called once, during runtest.exp setup.
proc libstdc++_init { testfile } {
global env
- global v3-sharedlib
+ global v3-sharedlib v3-libgomp
global srcdir blddir objdir tool_root_dir
global cc cxx cxxflags cxxpchflags cxxldflags
global includes
@@ -135,10 +135,13 @@ proc libstdc++_init { testfile } {
v3track gccdir 3
# Locate libgomp. This is only required for parallel mode.
+ set v3-libgomp 0
set libgompdir [lookfor_file $blddir/../libgomp .libs/libgomp.so]
if {$libgompdir != ""} {
+ set v3-libgomp 1
set libgompdir [file dirname $libgompdir]
append ld_library_path_tmp ":${libgompdir}"
+ verbose -log "libgomp support detected"
}
v3track libgompdir 3
@@ -968,7 +971,7 @@ proc check_v3_target_debug_mode { } {
proc check_v3_target_parallel_mode { } {
global cxxflags
- global DEFAULT_CXXFLAGS
+ global v3-libgomp
global et_parallel_mode
global tool
@@ -993,29 +996,9 @@ proc check_v3_target_parallel_mode { } {
} else {
set et_parallel_mode 0
- # Set up and compile a C++ test program that depends
- # on parallel mode working.
- set src parallel_mode[pid].cc
- set exe parallel_mode[pid].exe
-
- set f [open $src "w"]
- puts $f "#include <omp.h>"
- puts $f "int main()"
- puts $f "{ return 0; }"
- close $f
-
- set cxxflags_saved $cxxflags
- set cxxflags "$cxxflags $DEFAULT_CXXFLAGS -Werror"
-
- set lines [v3_target_compile $src $exe executable ""]
- set cxxflags $cxxflags_saved
- file delete $src
-
- if [string match "" $lines] {
- # No error message, compilation succeeded.
+ # If 'make check-parallel' is running the test succeeds.
+ if { ${v3-libgomp} == 1 && [regexp "libgomp" $cxxflags] } {
set et_parallel_mode 1
- } else {
- verbose "check_v3_target_parallel_mode: compilation failed" 2
}
}
verbose "check_v3_target_parallel_mode: $et_parallel_mode" 2