- 30 May, 2018 40 commits
-
-
* passes.c (ipa_write_summaries): Only modify statements if body is in memory. * cgraphunit.c (ipa_passes): Also produce intermeidate code when incrementally linking. (ipa_passes): Likewise. * lto-cgraph.c (lto_output_node): When incrementally linking do not pass down resolution info. * common.opt (flag_incremental_link): Update info. * gcc.c (plugin specs): Turn flinker-output=* to -plugin-opt=-linker-output-known * toplev.c (compile_file): Also cut compilation when doing incremental link. * flag-types. (enum lto_partition_model): Add LTO_LINKER_OUTPUT_NOLTOREL. (invoke.texi): Add -flinker-output docs. * ipa.c (symbol_table::remove_unreachable_nodes): Handle LTO incremental link same way as WPA; do not stream in dead initializers. From-SVN: r260964
Jan Hubicka committed -
* passes.c (ipa_write_summaries): Only modify statements if body is in memory. * cgraphunit.c (ipa_passes): Also produce intermeidate code when incrementally linking. (ipa_passes): Likewise. * lto-cgraph.c (lto_output_node): When incrementally linking do not pass down resolution info. * common.opt (flag_incremental_link): Update info. * gcc.c (plugin specs): Turn flinker-output=* to -plugin-opt=-linker-output-known * toplev.c (compile_file): Also cut compilation when doing incremental link. * flag-types. (enum lto_partition_model): Add LTO_LINKER_OUTPUT_NOLTOREL. (invoke.texi): Add -flinker-output docs. * ipa.c (symbol_table::remove_unreachable_nodes): Handle LTO incremental link same way as WPA; do not stream in dead initializers. * dwarf2out.c (dwarf2out_die_ref_for_decl, darf2out_register_external_decl): Support incremental link. * lang.opt (lto_linker_output): Add nolto-rel. * lto-lang.c (lto_post_options): Handle LTO_LINKER_OUTPUT_REL and LTO_LINKER_OUTPUT_NOLTOREL. (lto_init): Generate lto when doing incremental link. * lto.c (lto_precess_name): Add lto1-inclink. * testsuite/g++.dg/lto/20081109-1_0.C: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/20081118_0.C: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/20081119-1_0.C: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/20081120-1_0.C: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/20081120-2_0.C: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/20081123_0.C: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/20081204-1_0.C: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/20081219_0.C: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/20090302_0.C: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/20090313_0.C: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/20091002-2_0.C: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/20091002-3_0.C: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/20091026-1_0.C: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/20100724-1_0.C: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/20101010-4_0.C: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/20101015-2_0.C: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/20110311-1_0.C: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/pr45621_0.C: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/pr48042_0.C: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/pr48354-1_0.C: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/pr54625-1_0.c: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/pr54625-2_0.c: Add -flinker-output=nolto-rel. * testsuite/g++.dg/lto/pr68811_0.C: Add -flinker-output=nolto-rel. * testsuite/g++.dg/torture/pr43760.C: New test. Add -flinker-output=nolto-rel. * testsuite/gcc.dg/lto/20081120-1_0.c: Add -flinker-output=nolto-rel. * testsuite/gcc.dg/lto/20081120-2_0.c: Add -flinker-output=nolto-rel. * testsuite/gcc.dg/lto/20081126_0.c: Add -flinker-output=nolto-rel. * testsuite/gcc.dg/lto/20081204-1_0.c: Add -flinker-output=nolto-rel. * testsuite/gcc.dg/lto/20081204-2_0.c: Add -flinker-output=nolto-rel. * testsuite/gcc.dg/lto/20081212-1_0.c: Add -flinker-output=nolto-rel. * testsuite/gcc.dg/lto/20081224_0.c: Add -flinker-output=nolto-rel. * testsuite/gcc.dg/lto/20090116_0.c: Add -flinker-output=nolto-rel. * testsuite/gcc.dg/lto/20090126-1_0.c: Add -flinker-output=nolto-rel. * testsuite/gcc.dg/lto/20090126-2_0.c: Add -flinker-output=nolto-rel. * testsuite/gcc.dg/lto/20090206-1_0.c: Add -flinker-output=nolto-rel. * testsuite/gcc.dg/lto/20090219_0.c: Add -flinker-output=nolto-rel. * testsuite/gcc.dg/lto/20091013-1_0.c: Add -flinker-output=nolto-rel. * testsuite/gcc.dg/lto/20091014-1_0.c: Add -flinker-output=nolto-rel. * testsuite/gcc.dg/lto/20091015-1_0.c: Add -flinker-output=nolto-rel. * testsuite/gcc.dg/lto/20091016-1_0.c: Add -flinker-output=nolto-rel. * testsuite/gcc.dg/lto/20091020-1_0.c: Add -flinker-output-nolto-rel. * testsuite/gcc.dg/lto/20091020-2_0.c: Add -flinker-output-nolto-rel. * testsuite/gcc.dg/lto/20091027-1_0.c: Add -flinker-output-nolto-rel. * testsuite/gcc.dg/lto/20100426_0.c: Add -flinker-output-nolto-rel. * testsuite/gcc.dg/lto/20100430-1_0.c: Add -flinker-output-nolto-rel. * testsuite/gcc.dg/lto/20100603-1_0.c: Add -flinker-output-nolto-rel. * testsuite/gcc.dg/lto/20100603-2_0.c: Add -flinker-output-nolto-rel. * testsuite/gcc.dg/lto/20100603-3_0.c: Add -flinker-output-nolto-rel. * testsuite/gcc.dg/lto/20111213-1_0.c: Add -flinker-output-nolto-rel. * testsuite/gcc.dg/lto/pr45736_0.c: Add -flinker-output-nolto-rel. * testsuite/gcc.dg/lto/pr52634_0.c: Add -flinker-output-nolto-rel. * testsuite/gcc.dg/lto/pr54702_0.c: Add -flinker-output-nolto-rel. * testsuite/gcc.dg/lto/pr59323-2_0.c: Add -flinker-output-nolto-rel. * testsuite/gcc.dg/lto/pr59323_0.c: Add -flinker-output-nolto-rel. * testsuite/gcc.dg/lto/pr60820_0.c: Add -flinker-output-nolto-rel. * testsuite/gcc.dg/lto/pr81406_0.c: Add -flinker-output-nolto-rel. * testsuite/gcc.dg/lto/pr83388_0.c: Add -flinker-output-nolto-rel. * testsuite/gfortran.dg/lto/20091016-1_0.f90: Add -flinker-output-nolto-rel. * testsuite/gfortran.dg/lto/20091028-1_0.f90: Add -flinker-output-nolto-rel. * testsuite/gfortran.dg/lto/20091028-2_0.f90: Add -flinker-output-nolto-rel. * testsuite/gfortran.dg/lto/pr46911_0.f: Add -flinker-output-nolto-rel. * testsuite/gfortran.dg/lto/pr47839_0.f90: Add -flinker-output-nolto-rel. From-SVN: r260963
Jan Hubicka committed -
From-SVN: r260962
Jan Hubicka committed -
lto-wrapper.c (debug_objcopy): Add rename parameter; pass it down to simple_object_copy_lto_debug_sections. * lto-wrapper.c (debug_objcopy): Add rename parameter; pass it down to simple_object_copy_lto_debug_sections. (run_gcc): Determine incremental LTO link time and configure lto1 into non-wpa mode, disable renaming of debug sections. From-SVN: r260961
Jan Hubicka committed -
* lto-plugin.c: (non_claimed_files): New static var. (linker_ouput_known): New static var. (all_symbols_read_handler): When user specifies linker output do not imply it; output warning when nonlto-rel mode is forced. (claim_file_header): Record number of nonclaimed files. (process_option): Remember if linker output is known From-SVN: r260960
Jan Hubicka committed -
extend.texi (PowerPC AltiVec Built-in Functions): Remove descriptions of various incorrectly documented functions. gcc/ChangeLog: 2018-05-30 Kelvin Nilsen <kelvin@gcc.gnu.org> * doc/extend.texi (PowerPC AltiVec Built-in Functions): Remove descriptions of various incorrectly documented functions. From-SVN: r260959
Kelvin Nilsen committed -
From-SVN: r260958
Andre Vieira committed -
gcc 2018-05-30 Andre Vieira <andre.simoesdiasvieira@arm.com> 2018-05-24 Andre Vieira <andre.simoesdiasvieira@arm.com> PR target/83009 Revert: * config/aarch64/predicates.md (aarch64_mem_pair_lanes_operand): Make address check not strict. gcc/testsuite 2018-05-30 Andre Vieira <andre.simoesdiasvieira@arm.com> 2018-05-24 Andre Vieira <andre.simoesdiasvieira@arm.com> Revert PR target/83009 * gcc/target/aarch64/store_v2vec_lanes.c: Add extra tests. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@260635 138bc75d-0d04-0410-961f-82ee72b054a4 From-SVN: r260957Andre Vieira committed -
* simple-object.h (simple_object_copy_lto_debug_sections): Add rename parameter. * simple-object.c (handle_lto_debug_sections): Add rename parameter. (handle_lto_debug_sections_rename): New function. (handle_lto_debug_sections_norename): New function. (simple_object_copy_lto_debug_sections): Add rename parameter. From-SVN: r260956
Jan Hubicka committed -
2018-05-30 Richard Biener <rguenther@suse.de> PR tree-optimization/85964 * tracer.c (better_p): Drop initialized count check, we only call the function with initialized counts now. (find_best_successor): Do find a best edge if one has uninitialized count. (find_best_predecessor): Likewise. Do BB frequency check only if count is initialized. From-SVN: r260954
Richard Biener committed -
This patch generalizes the formation of LDP/STP that require a base register. In AArch64, LDP/STP instructions have different sized immediate offsets than normal LDR/STR instructions. This part of the backend attempts to spot groups of four LDR/STR instructions that can be turned into LDP/STP instructions by using a base register. Previously, we would only accept address pairs that were ordered in ascending or descending order, and only strictly sequential loads/stores. In fact, the instructions that we generate from this should be able to consider any order of loads or stores (provided that they can be re-ordered). They should also be able to accept non-sequential loads and stores provided that the two pairs of addresses are amenable to pairing. The current code is also overly restrictive on the range of addresses that are accepted, as LDP/STP instructions may take negative offsets as well as positive ones. This patch improves that by allowing us to accept all orders of loads/stores that are valid, and extending the range that the LDP/STP addresses can reach. 2017-05-30 Jackson Woodruff <jackson.woodruff@arm.com> * config/aarch64/aarch64.c (aarch64_host_wide_int_compare): New. (aarch64_ldrstr_offset_compare): New. (aarch64_operands_adjust_ok_for_ldpstp): Update to consider all load/store orderings. (aarch64_gen_adjusted_ldpstp): Likewise. * gcc.target/aarch64/simd/ldp_stp_9: New. * gcc.target/aarch64/simd/ldp_stp_10: New. * gcc.target/aarch64/simd/ldp_stp_11: New. * gcc.target/aarch64/simd/ldp_stp_12: New. From-SVN: r260952
Jackson Woodruff committed -
A recent commit removing '*' from the md files caused a large regression in h264ref. It turns out aarch64_ira_change_pseudo_allocno_class is no longer effective after the SVE changes, and the combination results in the regression. This patch fixes it by explicitly checking for a subset of GENERAL_REGS and FP_REGS. Add a missing ? to aarch64_get_lane to fix a failure in the testsuite. gcc/ * config/aarch64/aarch64.c (aarch64_ira_change_pseudo_allocno_class): Check for subset of GENERAL_REGS and FP_REGS. * config/aarch64/aarch64-simd.md (aarch64_get_lane): Increase cost of r=w alternative. From-SVN: r260951Wilco Dijkstra committed -
This was forgotten when renaming Get_Package_Instantiation_Node to Get_Unit_Instantiation_Node. 2018-05-30 Piotr Trojanek <trojanek@adacore.com> gcc/ada/ * einfo.ads (Package_Instantiation): Update comment after a routine that uses this field has been renamed. From-SVN: r260950
Piotr Trojanek committed -
2018-05-30 Ed Schonberg <schonberg@adacore.com> gcc/ada/ * exp_ch11.adb (Replace_Raise_By_Goto): The transfomation is legal even if the local raise statement includes a string expression. This expression might be picked up by an outer handler or discarded, but plays no role in this transformation. From-SVN: r260949
Ed Schonberg committed -
2018-05-30 Hristian Kirtchev <kirtchev@adacore.com> gcc/ada/ * exp_aggr.adb, exp_unst.adb, freeze.adb, libgnat/a-direct.adb: Minor reformatting. From-SVN: r260948
Hristian Kirtchev committed -
2018-05-30 Ed Schonberg <schonberg@adacore.com> gcc/ada/ * exp_unst.adb (Visit_Node): Handle the semantic Procedure_To_Call field in relevant nodes: Allocate, Free, and return statements. From-SVN: r260947
Ed Schonberg committed -
2018-05-30 Ed Schonberg <schonberg@adacore.com> gcc/ada/ * exp_unst.adb (Visit_Node): Do not traverse a Component_Association that has not been analyzed, as will be the case for a nested aggregate that is expanded into individual assignments. From-SVN: r260946
Ed Schonberg committed -
This patch implements AI12-0164-1 for the aspect/pragma Max_Entry_Queue_Depth. Previously, the GNAT specific pragma Max_Queue_Length fulfilled this role, but was not named to match the standard and thus was insufficent. ------------ -- Source -- ------------ -- pass.ads with System; package Pass is SOMETHING : constant Integer := 5; Variable : Boolean := False; protected type Protected_Example is entry A (Item : Integer) with Max_Entry_Queue_Depth => 2; -- OK entry B (Item : Integer); pragma Max_Entry_Queue_Depth (SOMETHING); -- OK entry C (Item : Integer); -- OK entry D (Item : Integer) with Max_Entry_Queue_Depth => 4; -- OK entry D (Item : Integer; Item_B : Integer) with Max_Entry_Queue_Depth => Float'Digits; -- OK entry E (Item : Integer); pragma Max_Entry_Queue_Depth (SOMETHING * 2); -- OK entry E (Item : Integer; Item_B : Integer); pragma Max_Entry_Queue_Depth (11); -- OK entry F (Item : Integer; Item_B : Integer); pragma Pre (Variable = True); pragma Max_Entry_Queue_Depth (11); -- OK entry G (Item : Integer; Item_B : Integer) with Pre => (Variable = True), Max_Entry_Queue_Depth => 11; -- OK private Data : Boolean := True; end Protected_Example; Prot_Ex : Protected_Example; end Pass; -- fail.ads package Fail is -- Not near entry pragma Max_Entry_Queue_Depth (40); -- ERROR -- Task type task type Task_Example is entry Insert (Item : in Integer) with Max_Entry_Queue_Depth => 10; -- ERROR -- Entry family in task type entry A (Positive) (Item : in Integer) with Max_Entry_Queue_Depth => 10; -- ERROR end Task_Example; Task_Ex : Task_Example; -- Aspect applied to protected type protected type Protected_Failure_0 with Max_Entry_Queue_Depth => 50 is -- ERROR entry A (Item : Integer); private Data : Integer := 0; end Protected_Failure_0; Protected_Failure_0_Ex : Protected_Failure_0; protected type Protected_Failure is pragma Max_Entry_Queue_Depth (10); -- ERROR -- Duplicates entry A (Item : Integer) with Max_Entry_Queue_Depth => 10; -- OK pragma Max_Entry_Queue_Depth (4); -- ERROR entry B (Item : Integer); pragma Max_Entry_Queue_Depth (40); -- OK pragma Max_Entry_Queue_Depth (4); -- ERROR entry C (Item : Integer) with Max_Entry_Queue_Depth => 10, -- OK Max_Entry_Queue_Depth => 40; -- ERROR -- Duplicates with the same value entry AA (Item : Integer) with Max_Entry_Queue_Depth => 10; -- OK pragma Max_Entry_Queue_Depth (10); -- ERROR entry BB (Item : Integer); pragma Max_Entry_Queue_Depth (40); -- OK pragma Max_Entry_Queue_Depth (40); -- ERROR entry CC (Item : Integer) with Max_Entry_Queue_Depth => 10, -- OK Max_Entry_Queue_Depth => 10; -- ERROR -- On subprogram procedure D (Item : Integer) with Max_Entry_Queue_Depth => 10; -- ERROR procedure E (Item : Integer); pragma Max_Entry_Queue_Depth (4); -- ERROR function F (Item : Integer) return Integer with Max_Entry_Queue_Depth => 10; -- ERROR function G (Item : Integer) return Integer; pragma Max_Entry_Queue_Depth (4); -- ERROR -- Bad parameters entry H (Item : Integer) with Max_Entry_Queue_Depth => 0; -- ERROR entry I (Item : Integer) with Max_Entry_Queue_Depth => -1; -- ERROR entry J (Item : Integer) with Max_Entry_Queue_Depth => 16#FFFF_FFFF_FFFF_FFFF_FFFF#; -- ERROR entry K (Item : Integer) with Max_Entry_Queue_Depth => False; -- ERROR entry L (Item : Integer) with Max_Entry_Queue_Depth => "JUNK"; -- ERROR entry M (Item : Integer) with Max_Entry_Queue_Depth => 1.0; -- ERROR entry N (Item : Integer) with Max_Entry_Queue_Depth => Long_Integer'(3); -- ERROR -- Entry family entry O (Boolean) (Item : Integer) with Max_Entry_Queue_Depth => 5; -- ERROR private Data : Integer := 0; end Protected_Failure; I : Positive := 1; Protected_Failure_Ex : Protected_Failure; end Fail; -- dtest.adb with Ada.Text_IO; use Ada.Text_IO; procedure Dtest is protected Prot is entry Wait; pragma Max_Entry_Queue_Depth (2); procedure Wakeup; private Barrier : Boolean := False; end Prot; protected body Prot is entry Wait when Barrier is begin null; end Wait; procedure Wakeup is begin Barrier := True; end Wakeup; end Prot; task type T; task body T is begin Put_Line ("Waiting..."); Prot.Wait; exception when others => Put_Line ("Got exception"); end T; T1, T2 : T; begin delay 0.1; Prot.Wait; Put_Line ("Done"); exception when others => Put_Line ("Main got exception"); Prot.Wakeup; end Dtest; ---------------------------- -- Compilation and output -- ---------------------------- & gcc -c -g -gnatDG pass.ads & gcc -c -g fail.ads & grep -c "(2, 5, 0, 4, 6, 10, 11, 11, 11)" pass.ads.dg & gnatmake -g -q dtest fail.ads:5:04: pragma "Max_Queue_Length" must apply to a protected entry fail.ads:12:15: aspect "Max_Queue_Length" cannot apply to task entries fail.ads:17:15: aspect "Max_Queue_Length" cannot apply to task entries fail.ads:26:12: aspect "Max_Queue_Length" must apply to a protected entry fail.ads:36:07: pragma "Max_Queue_Length" must apply to a protected entry fail.ads:42:07: pragma "Max_Queue_Length" duplicates aspect declared at line 41 fail.ads:46:07: pragma "Max_Queue_Length" duplicates pragma declared at line 45 fail.ads:50:15: aspect "Max_Queue_Length" for "C" previously given at line 49 fail.ads:56:07: pragma "Max_Queue_Length" duplicates aspect declared at line 55 fail.ads:60:07: pragma "Max_Queue_Length" duplicates pragma declared at line 59 fail.ads:64:15: aspect "Max_Queue_Length" for "CC" previously given at line 63 fail.ads:69:15: aspect "Max_Queue_Length" must apply to a protected entry fail.ads:72:07: pragma "Max_Queue_Length" must apply to a protected entry fail.ads:75:15: aspect "Max_Queue_Length" must apply to a protected entry fail.ads:78:07: pragma "Max_Queue_Length" must apply to a protected entry fail.ads:83:35: entity for aspect "Max_Queue_Length" must be positive fail.ads:86:35: entity for aspect "Max_Queue_Length" must be positive fail.ads:89:35: entity for aspect "Max_Queue_Length" out of range of Integer fail.ads:92:35: expected an integer type fail.ads:92:35: found type "Standard.Boolean" fail.ads:95:35: expected an integer type fail.ads:95:35: found a string type fail.ads:98:35: expected an integer type fail.ads:98:35: found type universal real 2018-05-30 Justin Squirek <squirek@adacore.com> gcc/ada/ * aspects.adb, aspects.ads: Register new aspect. * par-prag.adb (Prag): Register new pragma. * sem_ch13.adb (Analyze_Aspect_Specifications): Add processing for new aspect similar to Aspect_Max_Queue_Length. * sem_prag.adb, sem_prag.ads (Analyze_Pragma): Register new pragma and set it to use the same processing as Pragma_Max_Queue_Length. * snames.ads-tmpl: Move definition of Name_Max_Entry_Queue_Depth so that it can be processed as a pragma in addition to a restriction and add an entry for the pragma itself. From-SVN: r260945Justin Squirek committed -
This patch allows the GNAT-specific Thread_Local_Storage to be applied to variables of a composite type initiallized with an aggregate with static components that requires no elaboration code. 2018-05-30 Ed Schonberg <schonberg@adacore.com> gcc/ada/ * freeze.adb (Freeze_Object_Declaration): A pragma Thread_Local_Storage is now legal on a variable of composite type initialized with an aggregate that is fully static and requires no elaboration code. * exp_aggr.adb (Convert_To_Positional): Recognize additional cases of nested aggregates that are compile-time static, so they can be used to initialize variables declared with Threqd_Local_Storage. * doc/gnat_rm/implementation_defined_pragmas.rst: Add documentation on Thread_Local_Storage. * gnat_rm.texi: Regenerate. gcc/testsuite/ * gnat.dg/tls1.adb, gnat.dg/tls1_pkg.ads: New testcase. From-SVN: r260944
Ed Schonberg committed -
In the modes for static analysis with CodePeer or formal verification with GNATprove, the value of Assertion_Policy for a given policy is ignored if it's not Disable, as CodePeer/GNATprove are meant to check assertions even when not enabled at run time. This was not done consistently, which could lead to spurious errors on policy mismatch on ghost code inside assertions. There is no impact on compilation. 2018-05-30 Yannick Moy <moy@adacore.com> gcc/ada/ * sem_util.adb (Policy_In_Effect): Take into account CodePeer and GNATprove modes. From-SVN: r260943
Yannick Moy committed -
Implement a missing portion of Ada 2005's AI05-0049-1 for subprogram Ada.Directories.Name_Case_Equivalence so that user programs can account for operating system differences in case sensitivity. ------------ -- Source -- ------------ -- main.adb with Ada.Directories; use Ada.Directories; with Ada.Text_IO; use Ada.Text_IO; procedure Main is begin -- Directory layout: -- /empty +-- Nothing... -- -- /mutliplefiles +-- "TEST1.TXT" -- | -- "test1.txt" -- -- /singlefile +-- "test1.txt" -- -- /noncasable +-- "!" -- Put_Line (Name_Case_Equivalence ("./empty")'Image); Put_Line (Name_Case_Equivalence ("./multiplefiles")'Image); Put_Line (Name_Case_Equivalence ("./singlefile")'Image); Put_Line (Name_Case_Equivalence ("./multiplefiles/test1.txt")'Image); Put_Line (Name_Case_Equivalence ("./singlefile/test1.txt")'Image); Put_Line (Name_Case_Equivalence ("./noncaseable/!")'Image); end; ---------------------------- -- Compilation and Output -- ---------------------------- & gnatmake -q main.adb & main CASE_SENSITIVE CASE_SENSITIVE CASE_SENSITIVE CASE_SENSITIVE CASE_SENSITIVE CASE_SENSITIVE 2018-05-30 Justin Squirek <squirek@adacore.com> gcc/ada/ * libgnat/a-direct.adb, libgnat/a-direct.ads (Name_Case_Equivalence): Add implementation. (Start_Search): Modify to use Start_Search_Internal (Start_Search_Internal): Add to break out an extra flag for searching case insensative due to the potential for directories within the same OS to allow different casing schemes. * sysdep.c (__gnat_name_case_equivalence): Add as a default fallback for when the more precise solution fails. From-SVN: r260942Justin Squirek committed -
2018-05-30 Hristian Kirtchev <kirtchev@adacore.com> gcc/ada/ * checks.adb, exp_ch5.adb, exp_ch7.adb, exp_unst.adb, sem_eval.adb: Minor reformatting. From-SVN: r260941
Hristian Kirtchev committed -
Add support for Define_Switch with a callback in GNAT.Command_Line. The callback is called for every instance of the switch found on the command line. This make it possible to have full control over the switch value and chain multiple actions if needed. 2018-05-30 Pascal Obry <obry@adacore.com> gcc/ada/ * libgnat/g-comlin.ads (Value_Callback, Define_Switch): New. * libgnat/g-comlin.adb: Add corresponding implementation. From-SVN: r260940
Pascal Obry committed -
2018-05-30 Gary Dismukes <dismukes@adacore.com> gcc/ada/ * sem_res.adb, sem_util.adb: Fix several typos. From-SVN: r260939
Gary Dismukes committed -
Temporary change for experimental purposes. Further cleanups will be needed if this sheme works as we hope. 2018-05-30 Olivier Hainque <hainque@adacore.com> gcc/ada/ * vx_crtbegin_attr.c (CTOR_ATTRIBUTE, DTOR_ATTRIBUTE): Empty. (eh_registration_ctors, eh_registration_tors): New static variables, forced in a .ctors/.dtors section, respectively, with priority. From-SVN: r260938
Olivier Hainque committed -
2018-05-30 Bob Duff <duff@adacore.com> gcc/ada/ * aspects.ads, contracts.adb, exp_util.adb, expander.adb, expander.ads, freeze.adb, inline.adb, lib-xref.adb, sem.ads, sem_aggr.adb, sem_attr.adb, sem_ch13.adb, sem_ch3.adb, sem_ch5.adb, sem_ch6.adb, sem_ch8.adb, sem_dim.adb, sem_elab.adb, sem_res.adb, sem_res.ads, sinfo.ads: Spell preanalysis, preanalyze correctly. From-SVN: r260937
Bob Duff committed -
2018-05-30 Bob Duff <duff@adacore.com> gcc/ada/ * libgnat/g-sestin.ads: Rework documentation comments. From-SVN: r260936
Bob Duff committed -
Use a high-level Is_Rewrite_Substitution instead of a low-level inequality, with the intention to improve the code easier to read. Semantics unaffected, so no test provided. 2018-05-30 Piotr Trojanek <trojanek@adacore.com> gcc/ada/ * errout.adb, exp_aggr.adb, exp_ch7.adb, exp_util.adb, lib.adb, sem_ch13.adb, sem_ch4.adb, sem_res.adb, sem_util.adb (Has_Original_Node): Refactor to use Is_Rewrite_Substitution. From-SVN: r260935
Piotr Trojanek committed -
Checking "Original_Node (N) /= N" is equivalent to "Is_Rewrite_Substitution (N)", which is checked just two lines before. Trivial simplification, semantics unaffected. 2018-05-30 Piotr Trojanek <trojanek@adacore.com> gcc/ada/ * sem_prag.adb (Analyze_Pragma): Remove conjuncts that are always true. From-SVN: r260934
Piotr Trojanek committed -
This patch corrects the predicate which determines whether an entity denotes a synchronized object as per SPARK RM 9.1. to account for a case where the object is not atomic, but its type is. The patch also cleans up various atomic object-related predicates. 2018-05-30 Hristian Kirtchev <kirtchev@adacore.com> gcc/ada/ * sem_util.adb (Is_Atomic_Object): Cleaned up. Split the entity logic in a separate routine. (Is_Atomic_Object_Entity): New routine. (Is_Atomic_Prefix): Cleaned up. (Is_Synchronized_Object): Check that the object is atomic, or its type is atomic. (Object_Has_Atomic_Components): Removed. * sem_util.ads (Is_Atomic_Object): Reword the comment on usage. (Is_Atomic_Object_Entity): New routine. gcc/testsuite/ * gnat.dg/synchronized1.adb, gnat.dg/synchronized1.ads: New testcase. From-SVN: r260933
Hristian Kirtchev committed -
2018-05-30 Ed Schonberg <schonberg@adacore.com> gcc/ada/ * sem_ch3.adb (Access_Subprogram_Declaration): The flag Needs_Activation_Record is only needed on a subprogram type, not on a pointer to such. * sem_res.adb (Resolve_Selected_Component): If the context type and the component type are anonymous access to subprograms, use the component type to obtain the proper value of Needs_Activation_Record flag for the expression. From-SVN: r260932
Ed Schonberg committed -
2018-05-30 Eric Botcazou <ebotcazou@adacore.com> gcc/ada/ * gcc-interface/trans.c (gnat_to_gnu) <N_Assignment_Statement>: Add comment about the memset case. From-SVN: r260931
Eric Botcazou committed -
This patch fixes a memory leak bug. In particular, in a loop of the form "for X of ...", with a type that has the Iterable aspect specified, if the result of the Element function is returned on the secondary stack (e.g. the result subtype has caller-unknown size), then memory for the secondary stack could leak. 2018-05-30 Bob Duff <duff@adacore.com> gcc/ada/ * exp_ch5.adb (Expand_Formal_Container_Element_Loop): Remove the code to analyze the Elmt_Decl, because it gets analyzed in the wrong scope. We need to analyze it as part of analyzing the block, so that if the call to Element that initializes Elmt_Decl returns on the secondary stack, the block will ss_mark/ss_release. This block is inside the loop; we don't want to leak memory until the loop exits. The purpose of analyzing Elmt_Decl first was to catch the error of modifying it, which is illegal because it's a loop parameter. The above causes us to miss that error. Therefore, we add a flag Is_Loop_Parameter, and set it on the Element entity, so we end up with an E_Variable node with the flag set. * einfo.ads, einfo.adb (Is_Loop_Parameter): New flag. * sem_ch5.adb (Diagnose_Non_Variable_Lhs): Give the "assignment to loop parameter not allowed" error if Is_Loop_Parameter. * sem_util.adb (Is_Variable): Return False if Is_Loop_Parameter, to trigger the call to Diagnose_Non_Variable_Lhs. From-SVN: r260930
Bob Duff committed -
2018-05-30 Arnaud Charlet <charlet@adacore.com> gcc/ada/ * checks.adb (Apply_Scalar_Range_Check): * sem_eval.adb (Check_Non_Static_Context, Out_Of_Range): Ignore out of range values for System.Priority in CodePeer mode since the actual target compiler may provide a wider range. From-SVN: r260929
Arnaud Charlet committed -
2018-05-30 Ed Schonberg <schonberg@adacore.com> gcc/ada/ * exp_unst.adb: Search specification of main unit as well, for unnesting. From-SVN: r260928
Ed Schonberg committed -
2018-05-30 Ed Schonberg <schonberg@adacore.com> gcc/ada/ * exp_ch7.adb (Check_Unnesting_Elaboration_Code): The statement part of a package body that is a compilation unit may contain blocks that declare local subprograms. In Subprogram_Unnesting Mode such subprograms must be handled as nested inside the (implicit) elaboration procedure that executes that statement part. To handle properly uplevel references we construct that subprogram explicitly, to contain blocks and inner subprograms, The statement part of the compilation unit becomes a call to this subprogram. This is only done if blocks are present in the statement list of the body. From-SVN: r260927
Ed Schonberg committed -
2018-05-30 Bob Duff <duff@adacore.com> gcc/ada/ * exp_ch7.adb: Minor comment fix. From-SVN: r260926
Bob Duff committed -
2018-05-30 Ed Schonberg <schonberg@adacore.com> gcc/ada/ * exp_unst.adb (Visit_Node): Handle properly subprogram instantiations that have no corresponding body and appear as attributes of the corresponding wrapper package declaration. (Register_Subprogram): New subprogram, used for subprogram bodies and for subprogram instantiations to enter callable entity into Subp table. From-SVN: r260925
Ed Schonberg committed -
This patch reimplements the secondary stack runtime support as follows: * The compiler interface remains unchanged. This applies to both types and subprograms used by the compiler to create and manage secondary stacks. * The secondary stack is no longer a doubly linked list of chunks. * Various allocation scenarios are now handled by the same mechanism. In addition, the patch introduces a lightweight private interface for testing purposes. ------------ -- Source -- ------------ -- comparator.ads generic type Field_Typ is private; -- The type of the field being compared with function Image (Val : Field_Typ) return String; -- Field-to-String converted procedure Comparator (Field_Nam : String; Actual_Val : Field_Typ; Expected_Val : Field_Typ); -- Compare actual value Actual_Val against expected value Expected_Val for -- field Field_Nam. Emit an error if this is not the case. -- comparator.adb with Ada.Text_IO; use Ada.Text_IO; procedure Comparator (Field_Nam : String; Actual_Val : Field_Typ; Expected_Val : Field_Typ) is begin if Actual_Val /= Expected_Val then Put_Line (Field_Nam); Put_Line (" Actual :" & Image (Actual_Val)); Put_Line (" Expected :" & Image (Expected_Val)); end if; end Comparator; -- debugger.ads package Debugger is Verbouse : constant Boolean := False; -- Set to True in order to obtain verbouse output procedure Output (Msg : String); -- Emit Msg to standard output if Verbouse is True end Debugger; -- debugger.adb with Ada.Text_IO; use Ada.Text_IO; package body Debugger is ------------ -- Output -- ------------ procedure Output (Msg : String) is begin if Verbouse then Put_Line (Msg); end if; end Output; end Debugger; -- s-sestte.ads package System.Secondary_Stack.Tester is procedure Test_Dynamic_Stack_Dynamic_Chunks; -- Test various properties of a dynamic stack's dynamic chunks procedure Test_Dynamic_Stack_Illegal_Allocations; -- Test whether illegal allocations on a dynamic stack are properly -- detected and reported. procedure Test_Dynamic_Stack_Static_Chunk; -- Test various properties of a dynamic stack's static chunk procedure Test_Dynamic_Stack_Zero_Chunk_Size; -- Test various properties of a dynamic stack with default chunk size of -- zero. procedure Test_Static_Stack_Illegal_Allocations; -- Test whether illegal allocations on a static stack are properly -- detected and reported. procedure Test_Static_Stack_Overflow; -- Test whether overflow of a static stack's static chunk is properly -- detected and reported. procedure Test_Static_Stack_Static_Chunk; -- Test various properties of a static chunk's static chunk end System.Secondary_Stack.Tester; -- s-sestte.adb with Ada.Assertions; use Ada.Assertions; with Ada.Text_IO; use Ada.Text_IO; with System; use System; with System.Parameters; use System.Parameters; with System.Soft_Links; use System.Soft_Links; with System.Storage_Elements; use System.Storage_Elements; with Comparator; with Debugger; use Debugger; package body System.Secondary_Stack.Tester is Units : constant := Standard'Maximum_Alignment; -- Each allocation of the secondary stack is rouded up to the nearest -- multiple of the maximum alignment. This value is called a "unit" in -- order to facilitate further allocations. ----------------------- -- Local subprograms -- ----------------------- procedure Compare_Boolean is new Comparator (Field_Typ => Boolean, Image => Boolean'Image); procedure Compare_Chunk_Count is new Comparator (Field_Typ => Chunk_Count, Image => Chunk_Count'Image); procedure Compare_Chunk_Id is new Comparator (Field_Typ => Chunk_Id, Image => Chunk_Id'Image); procedure Compare_Memory_Index is new Comparator (Field_Typ => Memory_Index, Image => Memory_Index'Image); procedure Compare_Memory_Size is new Comparator (Field_Typ => Memory_Size, Image => Memory_Size'Image); procedure Compare_MSWI is new Comparator (Field_Typ => Memory_Size_With_Invalid, Image => Memory_Size_With_Invalid'Image); procedure Initialize_Stack (Size : Memory_Size); -- Create a new secondary stack for the calling task where the default -- chunk size is Size. procedure Match_Chunk (Match_Nam : String; Actual : Chunk_Info; Expected : Chunk_Info); -- Check whether actual chunk info Actual matches expected chunk info -- Expected. Match_Nam is the name of the match. procedure Match_Pointer (Actual : Stack_Pointer_Info; Expected : Stack_Pointer_Info); -- Check whether actual pointer info Actual matches expected pointer info -- Expected. procedure Match_Stack (Match_Nam : String; Actual : Stack_Info; Expected : Stack_Info); -- Check whether actual stack info Stack matches expected stack info -- Expected. Match_Nam is the name of the match. procedure Test_Static_Chunk (Def_Chunk_Size : Memory_Size); -- Common testing for properties of the static chunk for both static and -- dynamic secondary stacks. Def_Chunk_Size denotes the default size of a -- secondary stack chunk. This routine assumes that the secondary stack -- can fit 12 * Units. ---------------------- -- Initialize_Stack -- ---------------------- procedure Initialize_Stack (Size : Memory_Size) is Stack : SS_Stack_Ptr; begin -- Obtain the secondary stack of the calling task Stack := Get_Sec_Stack.all; -- If the calling task has an existing secodnary stack, destroy it -- because this scenario utilizes a custom secondary stack. if Stack /= null then -- Destroy the existing secondary stack because it will be replaced -- with a new one. SS_Free (Stack); pragma Assert (Stack = null); end if; -- Create a brand new empty secondary stack SS_Init (Stack, Size); pragma Assert (Stack /= null); -- Associate the secondary stack with the calling task Set_Sec_Stack (Stack); end Initialize_Stack; ----------------- -- Match_Chunk -- ----------------- procedure Match_Chunk (Match_Nam : String; Actual : Chunk_Info; Expected : Chunk_Info) is begin Output (Match_Nam); Compare_MSWI ("Size", Actual.Size, Expected.Size); Compare_MSWI ("Size_Up_To_Chunk", Actual.Size_Up_To_Chunk, Expected.Size_Up_To_Chunk); end Match_Chunk; ------------------- -- Match_Pointer -- ------------------- procedure Match_Pointer (Actual : Stack_Pointer_Info; Expected : Stack_Pointer_Info) is begin Compare_Memory_Index ("Byte", Actual.Byte, Expected.Byte); Compare_Chunk_Id ("Chunk", Actual.Chunk, Expected.Chunk); end Match_Pointer; ----------------- -- Match_Stack -- ----------------- procedure Match_Stack (Match_Nam : String; Actual : Stack_Info; Expected : Stack_Info) is begin Output (Match_Nam); Compare_Memory_Size ("Default_Chunk_Size", Actual.Default_Chunk_Size, Expected.Default_Chunk_Size); Compare_Boolean ("Freeable", Actual.Freeable, Expected.Freeable); Compare_Memory_Size ("High_Water_Mark", Actual.High_Water_Mark, Expected.High_Water_Mark); Compare_Chunk_Count ("Number_Of_Chunks", Actual.Number_Of_Chunks, Expected.Number_Of_Chunks); Match_Pointer (Actual.Top, Expected.Top); end Match_Stack; --------------------------------------- -- Test_Dynamic_Stack_Dynamic_Chunks -- --------------------------------------- procedure Test_Dynamic_Stack_Dynamic_Chunks is Def_Chunk_Size : constant Memory_Size := 4 * Units; Dummy_1 : Address; Dummy_2 : Address; Dummy_3 : Address; Dummy_4 : Address; Mark : Mark_Id; begin Output ("#### Test_DSDCs ####"); -- Create a brand new empty secondary stack -- -- 1 2 3 4 -- +------------+ -- | | -- +------------+ Initialize_Stack (Def_Chunk_Size); Match_Stack (Match_Nam => "Empty stack", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 0, Number_Of_Chunks => 1, Top => (Byte => 1, Chunk => 1))); Match_Chunk (Match_Nam => "Empty stack, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); -- Mark -- | -- 1 2 3 4 -- +------------+ -- | | -- +------------+ Mark := SS_Mark; -- Mark Top.Byte -- | | -- 1 2 3 4 1 2 3 4 5 6 -- +------------+ +---------------+ -- | |->|###############| -- +------------+ +---------------+ -- 1 2 3 4 5 6 7 8 9 -- | -- HWM SS_Allocate (Dummy_1, 5 * Units); Match_Stack (Match_Nam => "After 5u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 9 * Units, Number_Of_Chunks => 2, Top => (Byte => (5 * Units) + 1, Chunk => 2))); Match_Chunk (Match_Nam => "After 5u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); Match_Chunk (Match_Nam => "After 5u allocation, chunk 2", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 2), Expected => (Size => 5 * Units, Size_Up_To_Chunk => 4 * Units)); -- Mark Top.Byte -- | | -- 1 2 3 4 1 2 3 4 5 1 2 3 4 -- +------------+ +---------------+ +------------+ -- | |->|###############|->|###### | -- +------------+ +---------------+ +------------+ -- 1 2 3 4 5 6 7 8 9 10 11 12 13 -- | -- HWM -- -- Note that the size of Chunk 3 defaults to 4 because the request is -- smaller than the default chunk size. SS_Allocate (Dummy_2, 2 * Units); Match_Stack (Match_Nam => "After 2u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 11 * Units, Number_Of_Chunks => 3, Top => (Byte => (2 * Units) + 1, Chunk => 3))); Match_Chunk (Match_Nam => "After 2u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); Match_Chunk (Match_Nam => "After 2u allocation, chunk 2", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 2), Expected => (Size => 5 * Units, Size_Up_To_Chunk => 4 * Units)); Match_Chunk (Match_Nam => "After 2u allocation, chunk 3", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 3), Expected => (Size => 4 * Units, Size_Up_To_Chunk => 9 * Units)); -- Top.Byte -- | -- 1 2 3 4 1 2 3 4 5 1 2 3 4 -- +------------+ +---------------+ +------------+ -- | | --> |###############| --> |###### | -- +------------+ +---------------+ +------------+ -- 1 2 3 4 5 6 7 8 9 10 11 12 13 -- | -- HWM SS_Release (Mark); -- Top.Byte -- | -- 1 2 3 4 1 2 3 4 5 1 2 3 4 -- +------------+ +---------------+ +------------+ -- |######### | --> |###############| --> |###### | -- +------------+ +---------------+ +------------+ -- 1 2 3 4 5 6 7 8 9 10 11 12 13 -- | -- HWM SS_Allocate (Dummy_3, 3 * Units); Match_Stack (Match_Nam => "After 3u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 11 * Units, Number_Of_Chunks => 3, Top => (Byte => (3 * Units) + 1, Chunk => 1))); Match_Chunk (Match_Nam => "After 3u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); Match_Chunk (Match_Nam => "After 3u allocation, chunk 2", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 2), Expected => (Size => 5 * Units, Size_Up_To_Chunk => 4 * Units)); Match_Chunk (Match_Nam => "After 3u allocation, chunk 3", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 3), Expected => (Size => 4 * Units, Size_Up_To_Chunk => 9 * Units)); -- Top.Byte -- | -- 1 2 3 4 1 2 3 4 5 6 7 8 9 -- +------------+ +------------------------+ -- |######### | --> |########################| -- +------------+ +------------------------+ -- 1 2 3 4 5 6 7 8 9 10 11 12 -- | -- HWM SS_Allocate (Dummy_4, 8 * Units); Match_Stack (Match_Nam => "After 8u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 12 * Units, Number_Of_Chunks => 2, Top => (Byte => (8 * Units) + 1, Chunk => 2))); Match_Chunk (Match_Nam => "After 8u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); Match_Chunk (Match_Nam => "After 8u allocation, chunk 2", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 2), Expected => (Size => 8 * Units, Size_Up_To_Chunk => 4 * Units)); exception when others => Put_Line ("Test_DSDCs: unexpected exception"); end Test_Dynamic_Stack_Dynamic_Chunks; -------------------------------------------- -- Test_Dynamic_Stack_Illegal_Allocations -- -------------------------------------------- procedure Test_Dynamic_Stack_Illegal_Allocations is Def_Chunk_Size : constant Memory_Size := 4 * Units; Dummy_1 : Address; Dummy_2 : Address; begin Output ("#### Test_DSIA ####"); -- Create a brand new empty secondary stack -- -- 1 2 3 4 -- +------------+ -- | | -- +------------+ Initialize_Stack (Def_Chunk_Size); Match_Stack (Match_Nam => "Empty stack", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 0, Number_Of_Chunks => 1, Top => (Byte => 1, Chunk => 1))); Match_Chunk (Match_Nam => "Empty stack, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); -- It should not be possible to allocate an object of size zero Zero_Allocation : begin SS_Allocate (Dummy_1, 0); Put_Line ("Test_DSIA: ERROR: zero allocation succeeded"); exception when Assertion_Error => Match_Stack (Match_Nam => "After zero allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 0, Number_Of_Chunks => 1, Top => (Byte => 1, Chunk => 1))); Match_Chunk (Match_Nam => "After zero allocation", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); when others => Put_Line ("Test_DSIA: zero allocation: unexpected exception"); end Zero_Allocation; -- It should not be possible to allocate an object of negative size Negative_Allocation : begin SS_Allocate (Dummy_2, -8); Put_Line ("Test_DSIA: ERROR: negative allocation succeeded"); exception when Assertion_Error => Match_Stack (Match_Nam => "After negative allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 0, Number_Of_Chunks => 1, Top => (Byte => 1, Chunk => 1))); Match_Chunk (Match_Nam => "After negative allocation", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); when others => Put_Line ("Test_DSIA: negative allocation: unexpected exception"); end Negative_Allocation; exception when others => Put_Line ("Test_DSIA: unexpected exception"); end Test_Dynamic_Stack_Illegal_Allocations; ------------------------------------- -- Test_Dynamic_Stack_Static_Chunk -- ------------------------------------- procedure Test_Dynamic_Stack_Static_Chunk is Def_Chunk_Size : constant Memory_Size := 12 * Units; Dummy_1 : Address; Dummy_2 : Address; Dummy_3 : Address; Dummy_4 : Address; Mark_1 : Mark_Id; Mark_2 : Mark_Id; begin Output ("#### Test_DSSC ####"); -- Create a brand new empty secondary stack -- -- 1 2 3 4 5 6 7 8 9 10 11 12 -- +------------------------------------+ -- | | -- +------------------------------------+ Initialize_Stack (Def_Chunk_Size); Test_Static_Chunk (Def_Chunk_Size); exception when others => Put_Line ("Test_DSSC: unexpected exception"); end Test_Dynamic_Stack_Static_Chunk; ---------------------------------------- -- Test_Dynamic_Stack_Zero_Chunk_Size -- ---------------------------------------- procedure Test_Dynamic_Stack_Zero_Chunk_Size is Def_Chunk_Size : constant Memory_Size := 0; Dummy_1 : Address; Dummy_2 : Address; Mark : Mark_Id; begin Output ("#### Test_DSZCS ####"); -- Create a brand new empty secondary stack -- -- ++ -- || -- ++ Initialize_Stack (Def_Chunk_Size); Match_Stack (Match_Nam => "Empty stack", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 0, Number_Of_Chunks => 1, Top => (Byte => 1, Chunk => 1))); Match_Chunk (Match_Nam => "Empty stack, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); -- Mark -- | -- 1 -- ++ -- || -- ++ Mark := SS_Mark; -- Mark Top.Byte -- | | -- | 1 2 3 4 -- ++ +---------+ -- ||->|#########| -- ++ +---------+ -- 1 2 3 -- | -- HWM SS_Allocate (Dummy_1, 3 * Units); Match_Stack (Match_Nam => "After 3u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 3 * Units, Number_Of_Chunks => 2, Top => (Byte => (3 * Units) + 1, Chunk => 2))); Match_Chunk (Match_Nam => "After 3u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); Match_Chunk (Match_Nam => "After 3u allocation, chunk 2", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 2), Expected => (Size => 3 * Units, Size_Up_To_Chunk => 0)); -- Mark Top.Byte -- | | -- | 1 2 3 1 2 3 -- ++ +---------+ +------+ -- ||->|#########|->|######| -- ++ +---------+ +------+ -- 1 2 3 4 5 -- | -- HWM SS_Allocate (Dummy_2, 2 * Units); Match_Stack (Match_Nam => "After 2u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 5 * Units, Number_Of_Chunks => 3, Top => (Byte => (2 * Units) + 1, Chunk => 3))); Match_Chunk (Match_Nam => "After 2u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); Match_Chunk (Match_Nam => "After 2u allocation, chunk 2", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 2), Expected => (Size => 3 * Units, Size_Up_To_Chunk => 0)); Match_Chunk (Match_Nam => "After 2u allocation, chunk 3", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 3), Expected => (Size => 2 * Units, Size_Up_To_Chunk => 3 * Units)); -- Top.Byte -- | -- | 1 2 3 1 2 -- ++ +---------+ +------+ -- ||->|#########|->|######| -- ++ +---------+ +------+ -- 1 2 3 4 5 -- | -- HWM SS_Release (Mark); -- Top.Byte -- | -- 1 2 3 4 5 6 7 -- ++ +------------------+ -- ||->|##################| -- ++ +------------------+ -- 1 2 3 4 5 6 -- | -- HWM SS_Allocate (Dummy_2, 6 * Units); Match_Stack (Match_Nam => "After 6u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 6 * Units, Number_Of_Chunks => 2, Top => (Byte => (6 * Units) + 1, Chunk => 2))); Match_Chunk (Match_Nam => "After 6u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); Match_Chunk (Match_Nam => "After 6u allocation, chunk 2", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 2), Expected => (Size => 6 * Units, Size_Up_To_Chunk => 0)); exception when others => Put_Line ("Test_DSZCS: unexpected exception"); end Test_Dynamic_Stack_Zero_Chunk_Size; ----------------------- -- Test_Static_Chunk -- ----------------------- procedure Test_Static_Chunk (Def_Chunk_Size : Memory_Size) is Dummy_1 : Address; Dummy_2 : Address; Dummy_3 : Address; Dummy_4 : Address; Mark_1 : Mark_Id; Mark_2 : Mark_Id; begin -- This routine assumes an empty secondary stack Match_Stack (Match_Nam => "Empty stack", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 0, Number_Of_Chunks => 1, Top => (Byte => 1, Chunk => 1))); Match_Chunk (Match_Nam => "Empty stack, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); -- Top.Byte -- | -- 1 2 3 4 5 6 7 8 9 10 11 12 -- +------------------------------------. . . -- |############ -- +------------------------------------. . . -- | -- HWM SS_Allocate (Dummy_1, 4 * Units); Match_Stack (Match_Nam => "After 4u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 4 * Units, Number_Of_Chunks => 1, Top => (Byte => (4 * Units) + 1, Chunk => 1))); Match_Chunk (Match_Nam => "After 4u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); -- Mark_1 -- Top.Byte -- | -- 1 2 3 4 5 6 7 8 9 10 11 12 -- +------------------------------------. . . -- |############ -- +------------------------------------. . . -- | -- HWM Mark_1 := SS_Mark; -- Mark_1 -- | Top.Byte -- | | -- 1 2 3 4 5 6 7 8 9 10 11 12 -- +------------------------------------. . . -- |########################### -- +------------------------------------. . . -- | -- HWM SS_Allocate (Dummy_2, 5 * Units); Match_Stack (Match_Nam => "After 5u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 9 * Units, Number_Of_Chunks => 1, Top => (Byte => (9 * Units) + 1, Chunk => 1))); Match_Chunk (Match_Nam => "After 5u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); -- Mark_1 Mark_2 -- | Top.Byte -- | | -- 1 2 3 4 5 6 7 8 9 10 11 12 -- +------------------------------------. . . -- |########################### -- +------------------------------------. . . -- | -- HWM Mark_2 := SS_Mark; -- Mark_1 Mark_2 -- | | Top.Byte -- | | | -- 1 2 3 4 5 6 7 8 9 10 11 12 -- +------------------------------------. . . -- |################################# -- +------------------------------------. . . -- | -- HWM SS_Allocate (Dummy_3, 2 * Units); Match_Stack (Match_Nam => "After 2u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 11 * Units, Number_Of_Chunks => 1, Top => (Byte => (11 * Units) + 1, Chunk => 1))); Match_Chunk (Match_Nam => "After 2u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); -- Mark_1 -- | Top.Byte -- | | -- 1 2 3 4 5 6 7 8 9 10 11 12 -- +------------------------------------. . . -- |################################# -- +------------------------------------. . . -- | -- HWM SS_Release (Mark_2); Match_Stack (Match_Nam => "After Mark_2 release", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 11 * Units, Number_Of_Chunks => 1, Top => (Byte => (9 * Units) + 1, Chunk => 1))); Match_Chunk (Match_Nam => "After Mark_2 release, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); -- Top.Byte -- | -- 1 2 3 4 5 6 7 8 9 10 11 12 -- +------------------------------------. . . -- |################################# -- +------------------------------------. . . -- | -- HWM SS_Release (Mark_1); Match_Stack (Match_Nam => "After Mark_1 release", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 11 * Units, Number_Of_Chunks => 1, Top => (Byte => (4 * Units) + 1, Chunk => 1))); Match_Chunk (Match_Nam => "After Mark_1 release, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); -- Top.Byte -- | -- 1 2 3 4 5 6 7 8 9 10 11 12 -- +------------------------------------. . . -- |################################# -- +------------------------------------. . . -- | -- HWM SS_Allocate (Dummy_4, 6 * Units); Match_Stack (Match_Nam => "After 6u allocation", Actual => Get_Stack_Info (Get_Sec_Stack.all), Expected => (Default_Chunk_Size => Def_Chunk_Size, Freeable => True, High_Water_Mark => 11 * Units, Number_Of_Chunks => 1, Top => (Byte => (10 * Units) + 1, Chunk => 1))); Match_Chunk (Match_Nam => "After 6u allocation, chunk 1", Actual => Get_Chunk_Info (Get_Sec_Stack.all, 1), Expected => (Size => Def_Chunk_Size, Size_Up_To_Chunk => 0)); end Test_Static_Chunk; ------------------------------------------- -- Test_Static_Stack_Illegal_Allocations -- ------------------------------------------- procedure Test_Static_Stack_Illegal_Allocations is Dummy_1 : Address; Dummy_2 : Address; begin Output ("#### Test_SSIA ####"); -- It should not be possible to allocate an object of size zero Zero_Allocation : begin SS_Allocate (Dummy_1, 0); Put_Line ("Test_SSIA: ERROR: zero allocation succeeded"); exception when Assertion_Error => Output ("After zero allocation"); when others => Put_Line ("Test_SSIA: zero allocation: unexpected exception"); end Zero_Allocation; -- It should not be possible to allocate an object of negative size Negative_Allocation : begin SS_Allocate (Dummy_2, -8); Put_Line ("Test_SSIA: ERROR: negative allocation succeeded"); exception when Assertion_Error => Output ("After negative allocation"); when others => Put_Line ("Test_SSIA: negative allocation: unexpected exception"); end Negative_Allocation; exception when others => Put_Line ("Test_SSIA: unexpected exception"); end Test_Static_Stack_Illegal_Allocations; -------------------------------- -- Test_Static_Stack_Overflow -- -------------------------------- procedure Test_Static_Stack_Overflow is Info : constant Stack_Info := Get_Stack_Info (Get_Sec_Stack.all); Dummy : Address; begin Output ("#### Test_SSO ####"); -- Try to overflow the static chunk Overflow : begin SS_Allocate (Dummy, Storage_Offset (Info.Default_Chunk_Size)); Put_Line ("Test_SSO: ERROR: Overflow not detected"); exception when Storage_Error => Output ("After overflow"); when others => Put_Line ("Test_SSO: overflow: unexpected exception"); end Overflow; exception when others => Put_Line ("Test_SSO: unexpected exception"); end Test_Static_Stack_Overflow; ------------------------------------ -- Test_Static_Stack_Static_Chunk -- ------------------------------------ procedure Test_Static_Stack_Static_Chunk is Info : Stack_Info; begin Output ("#### Test_SSSC ####"); Info := Get_Stack_Info (Get_Sec_Stack.all); Test_Static_Chunk (Info.Default_Chunk_Size); exception when others => Put_Line ("Test_SSSC: unexpected exception"); end Test_Static_Stack_Static_Chunk; end System.Secondary_Stack.Tester; -- main.adb with Ada.Text_IO; use Ada.Text_IO; with System.Parameters; use System.Parameters; with System.Secondary_Stack.Tester; use System.Secondary_Stack.Tester; procedure Main is task Tester; -- The various scenarios are tested within a task because this guarantees -- that on a normal compilation, the task's secondary stack is created on -- the heap and can be safely freed and replaced with a custom one. task body Tester is begin if Sec_Stack_Dynamic then Test_Dynamic_Stack_Static_Chunk; Test_Dynamic_Stack_Dynamic_Chunks; Test_Dynamic_Stack_Zero_Chunk_Size; Test_Dynamic_Stack_Illegal_Allocations; else Test_Static_Stack_Static_Chunk; Test_Static_Stack_Overflow; Test_Static_Stack_Illegal_Allocations; end if; end Tester; begin null; end Main; ----------------- -- Compilation -- ----------------- $ gnatmake -a -f -q -gnata -gnatws main.adb $ ./main 2018-05-30 Hristian Kirtchev <kirtchev@adacore.com> gcc/ada/ * libgnat/s-secsta.adb: Reimplement the secondary stack support. * libgnat/s-secsta.ads: Update the documentation of all routines in the public part of the package. Reimplement the private part of the package to account for the new secondary stack structure. Add types and subprograms for testing purposes. Add several documentation sections. From-SVN: r260924Hristian Kirtchev committed -
2018-05-30 Hristian Kirtchev <kirtchev@adacore.com> gcc/ada/ * exp_aggr.adb, exp_ch3.adb, exp_ch4.adb, exp_ch7.adb, exp_unst.adb, exp_util.adb, exp_util.ads, libgnat/a-calcon.adb, libgnat/a-calcon.ads, libgnat/s-os_lib.adb, repinfo.adb, sem_ch3.adb, sem_disp.adb, sem_disp.ads, sem_util.adb: Minor reformatting. From-SVN: r260923
Hristian Kirtchev committed
-
