From 5d733372faa97c1c3943a20a252d000db37c738b Mon Sep 17 00:00:00 2001 From: Alexandre Oliva Date: Fri, 2 Aug 2019 18:46:51 +0000 Subject: rework Ada EH Machine_Occurrence deallocation Introduce exception handler ABI #1 to ensure single release, no access after release of reraised Machine_Occurrences, and no failure to re-reraise a Machine_Occurrence. Unlike Ada exceptions, foreign exceptions do not get a new Machine_Occurrence upon reraise, but each handler would delete the exception upon completion, normal or exceptional, save for the case of a 'raise;' statement within the handler, that avoided the delete by clearing the exception pointer that the cleanup would use to release it. The cleared exception pointer might then be used by a subsequent reraise within the same handler. Get_Current_Excep.all would also expose the Machine_Occurrence to reuse by Reraise_Occurrence, even for native exceptions. Under ABI #1, Begin_Handler_v1 claims responsibility for releasing an exception by saving its cleanup and setting it to Claimed_Cleanup. End_Handler_v1 restores the cleanup and runs it, as long as it isn't still Claimed_Cleanup (which indicates an enclosing handler has already claimed responsibility for releasing it), and as long as the same exception is not being propagated up (the next handler of the propagating exception will then claim responsibility for releasing it), so reraise no longer needs to clear the exception pointer, and it can just propagate the exception, just like Reraise_Occurrence. ABI #1 is fully interoperable with ABI #0, i.e., exception handlers that call the #0 primitives can be linked together with ones that call the #1 primitives, and they will not misbehave. When a #1 handler claims responsibility for releasing an exception, even #0 reraises dynamically nested within it will refrain from releasing it. However, when a #0 handler is a handler of a foreign exception that would have been responsible for releasing it with #1, a Reraise_Occurrence of that foreign or other Machine_Occurrence-carrying exception may still cause the exception to be released multiple times, and to be used after it is first released, even if other handlers of the foreign exception use #1. for gcc/ada/ChangeLog * libgnat/a-exexpr.adb (Begin_Handler_v1, End_Handler_v1): New. (Claimed_Cleanup): New. (Begin_Handler, End_Handler): Document. * gcc-interface/trans.c (gigi): Switch to exception handler ABI #1. (Exception_Handler_to_gnu_gcc): Save the original cleanup returned by begin handler, pass it to end handler, and use EH_ELSE_EXPR to pass a propagating exception to end handler. (gnat_to_gnu): Leave the exception pointer alone for reraise. (add_cleanup): Handle EH_ELSE_EXPR, require it by itself. From-SVN: r274029 --- gcc/ada/ChangeLog | 13 +++ gcc/ada/gcc-interface/trans.c | 162 ++++++++++++++++++++++++++---------- gcc/ada/libgnat/a-exexpr.adb | 188 +++++++++++++++++++++++++++++++++++++++++- 3 files changed, 316 insertions(+), 47 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 64ac98b..bcfc8cc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2019-08-02 Alexandre Oliva + + * libgnat/a-exexpr.adb (Begin_Handler_v1, End_Handler_v1): New. + (Claimed_Cleanup): New. + (Begin_Handler, End_Handler): Document. + * gcc-interface/trans.c (gigi): Switch to exception handler + ABI #1. + (Exception_Handler_to_gnu_gcc): Save the original cleanup + returned by begin handler, pass it to end handler, and use + EH_ELSE_EXPR to pass a propagating exception to end handler. + (gnat_to_gnu): Leave the exception pointer alone for reraise. + (add_cleanup): Handle EH_ELSE_EXPR, require it by itself. + 2019-07-23 Ed Schonberg * sem_ch13.adb (Check_Aspect_At_End_Of_Declarations, diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 6cd3759..b484bc7 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -524,22 +524,27 @@ gigi (Node_Id gnat_root, NULL_TREE, is_default, true, true, true, false, false, NULL, Empty); /* Hooks to call when entering/leaving an exception handler. */ - ftype = build_function_type_list (void_type_node, ptr_type_node, NULL_TREE); - + ftype = build_function_type_list (ptr_type_node, + ptr_type_node, NULL_TREE); begin_handler_decl - = create_subprog_decl (get_identifier ("__gnat_begin_handler"), NULL_TREE, - ftype, NULL_TREE, + = create_subprog_decl (get_identifier ("__gnat_begin_handler_v1"), + NULL_TREE, ftype, NULL_TREE, is_default, true, true, true, false, false, NULL, Empty); - /* __gnat_begin_handler is a dummy procedure. */ + /* __gnat_begin_handler_v1 is not a dummy procedure, but we arrange + for it not to throw. */ TREE_NOTHROW (begin_handler_decl) = 1; + ftype = build_function_type_list (ptr_type_node, + ptr_type_node, ptr_type_node, + ptr_type_node, NULL_TREE); end_handler_decl - = create_subprog_decl (get_identifier ("__gnat_end_handler"), NULL_TREE, + = create_subprog_decl (get_identifier ("__gnat_end_handler_v1"), NULL_TREE, ftype, NULL_TREE, is_default, true, true, true, false, false, NULL, Empty); + ftype = build_function_type_list (void_type_node, ptr_type_node, NULL_TREE); unhandled_except_decl = create_subprog_decl (get_identifier ("__gnat_unhandled_except_handler"), NULL_TREE, ftype, NULL_TREE, @@ -6201,37 +6206,55 @@ Exception_Handler_to_gnu_gcc (Node_Id gnat_node) start_stmt_group (); gnat_pushlevel (); - /* Expand a call to the begin_handler hook at the beginning of the handler, - and arrange for a call to the end_handler hook to occur on every possible - exit path. + /* Expand a call to the begin_handler hook at the beginning of the + handler, and arrange for a call to the end_handler hook to occur + on every possible exit path. GDB sets a breakpoint in the + begin_handler for catchpoints. - The hooks expect a pointer to the low level occurrence. This is required - for our stack management scheme because a raise inside the handler pushes - a new occurrence on top of the stack, which means that this top does not - necessarily match the occurrence this handler was dealing with. + A v1 begin handler saves the cleanup from the exception object, + and marks the exception as in use, so that it will not be + released by other handlers. A v1 end handler restores the + cleanup and releases the exception object, unless it is still + claimed, or the exception is being propagated (reraised). __builtin_eh_pointer references the exception occurrence being - propagated. Upon handler entry, this is the exception for which the - handler is triggered. This might not be the case upon handler exit, - however, as we might have a new occurrence propagated by the handler's - body, and the end_handler hook called as a cleanup in this context. - - We use a local variable to retrieve the incoming value at handler entry - time, and reuse it to feed the end_handler hook's argument at exit. */ - + handled or propagated. Within the handler region, it is the + former, but within the else branch of the EH_ELSE_EXPR, i.e. the + exceptional cleanup path, it is the latter, so we must save the + occurrence being handled early on, so that, should an exception + be (re)raised, we can release the current exception, or figure + out we're not to release it because we're propagating a reraise + thereof. + + We use local variables to retrieve the incoming value at handler + entry time (EXPTR), the saved cleanup (EXCLN) and the token + (EXVTK), and reuse them to feed the end_handler hook's argument + at exit. */ + + /* CODE: void *EXPTR = __builtin_eh_pointer (0); */ tree gnu_current_exc_ptr = build_call_expr (builtin_decl_explicit (BUILT_IN_EH_POINTER), 1, integer_zero_node); - tree prev_gnu_incoming_exc_ptr = gnu_incoming_exc_ptr; - gnu_incoming_exc_ptr + tree exc_ptr = create_var_decl (get_identifier ("EXPTR"), NULL_TREE, ptr_type_node, gnu_current_exc_ptr, - false, false, false, false, false, true, true, + true, false, false, false, false, true, true, NULL, gnat_node); - add_stmt_with_node (build_call_n_expr (begin_handler_decl, 1, - gnu_incoming_exc_ptr), - gnat_node); + tree prev_gnu_incoming_exc_ptr = gnu_incoming_exc_ptr; + gnu_incoming_exc_ptr = exc_ptr; + + /* begin_handler_decl must not throw, so we can use it as an + initializer for a variable used in cleanups. + + CODE: void *EXCLN = __gnat_begin_handler_v1 (EXPTR); */ + tree exc_cleanup + = create_var_decl (get_identifier ("EXCLN"), NULL_TREE, + ptr_type_node, + build_call_n_expr (begin_handler_decl, 1, + exc_ptr), + true, false, false, false, false, + true, true, NULL, gnat_node); /* Declare and initialize the choice parameter, if present. */ if (Present (Choice_Parameter (gnat_node))) @@ -6239,21 +6262,64 @@ Exception_Handler_to_gnu_gcc (Node_Id gnat_node) tree gnu_param = gnat_to_gnu_entity (Choice_Parameter (gnat_node), NULL_TREE, true); + /* CODE: __gnat_set_exception_parameter (&choice_param, EXPTR); */ add_stmt (build_call_n_expr (set_exception_parameter_decl, 2, build_unary_op (ADDR_EXPR, NULL_TREE, gnu_param), gnu_incoming_exc_ptr)); } + /* CODE: */ add_stmt_list (Statements (gnat_node)); - /* We don't have an End_Label at hand to set the location of the cleanup - actions, so we use that of the exception handler itself instead. */ - tree stmt = build_call_n_expr (end_handler_decl, 1, gnu_incoming_exc_ptr); + tree call = build_call_n_expr (end_handler_decl, 3, + exc_ptr, + exc_cleanup, + null_pointer_node); + /* If the handler can only end by falling off the end, don't bother + with cleanups. */ if (stmt_list_cannot_alter_control_flow_p (Statements (gnat_node))) - add_stmt_with_node (stmt, gnat_node); + /* CODE: __gnat_end_handler_v1 (EXPTR, EXCLN, NULL); */ + add_stmt_with_node (call, gnat_node); + /* Otherwise, all of the above is after + CODE: try { + + The call above will appear after + CODE: } finally { + + And the code below will appear after + CODE: } else { + + The else block to a finally block is taken instead of the finally + block when an exception propagates out of the try block. */ else - add_cleanup (stmt, gnat_node); + { + start_stmt_group (); + gnat_pushlevel (); + /* CODE: void *EXPRP = __builtin_eh_handler (0); */ + tree prop_ptr + = create_var_decl (get_identifier ("EXPRP"), NULL_TREE, + ptr_type_node, + build_call_expr (builtin_decl_explicit + (BUILT_IN_EH_POINTER), + 1, integer_zero_node), + true, false, false, false, false, + true, true, NULL, gnat_node); + + /* CODE: __gnat_end_handler_v1 (EXPTR, EXCLN, EXPRP); */ + tree ecall = build_call_n_expr (end_handler_decl, 3, + exc_ptr, + exc_cleanup, + prop_ptr); + + add_stmt_with_node (ecall, gnat_node); + + /* CODE: } */ + gnat_poplevel (); + tree eblk = end_stmt_group (); + tree ehls = build2 (EH_ELSE_EXPR, void_type_node, call, eblk); + add_cleanup (ehls, gnat_node); + } gnat_poplevel (); @@ -8270,19 +8336,11 @@ gnat_to_gnu (Node_Id gnat_node) gcc_assert (No (Name (gnat_node)) && Back_End_Exceptions ()); start_stmt_group (); - gnat_pushlevel (); - /* Clear the current exception pointer so that the occurrence won't be - deallocated. */ - gnu_expr = create_var_decl (get_identifier ("SAVED_EXPTR"), NULL_TREE, - ptr_type_node, gnu_incoming_exc_ptr, - false, false, false, false, false, - true, true, NULL, gnat_node); + add_stmt_with_node (build_call_n_expr (reraise_zcx_decl, 1, + gnu_incoming_exc_ptr), + gnat_node); - add_stmt (build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_incoming_exc_ptr, - build_int_cst (ptr_type_node, 0))); - add_stmt (build_call_n_expr (reraise_zcx_decl, 1, gnu_expr)); - gnat_poplevel (); gnu_result = end_stmt_group (); break; @@ -9073,7 +9131,23 @@ add_cleanup (tree gnu_cleanup, Node_Id gnat_node) { if (Present (gnat_node)) set_expr_location_from_node (gnu_cleanup, gnat_node, true); - append_to_statement_list (gnu_cleanup, ¤t_stmt_group->cleanups); + /* An EH_ELSE_EXPR must be by itself, and that's all we need when we + use it. The assert below makes sure that is so. Should we ever + need more than that, we could combine EH_ELSE_EXPRs, and copy + non-EH_ELSE_EXPR stmts into both cleanup paths of an + EH_ELSE_EXPR. */ + if (TREE_CODE (gnu_cleanup) == EH_ELSE_EXPR) + { + gcc_assert (!current_stmt_group->cleanups); + current_stmt_group->cleanups = gnu_cleanup; + } + else + { + gcc_assert (!current_stmt_group->cleanups + || (TREE_CODE (current_stmt_group->cleanups) + != EH_ELSE_EXPR)); + append_to_statement_list (gnu_cleanup, ¤t_stmt_group->cleanups); + } } /* Set the BLOCK node corresponding to the current code group to GNU_BLOCK. */ diff --git a/gcc/ada/libgnat/a-exexpr.adb b/gcc/ada/libgnat/a-exexpr.adb index b1aa1c6..5e72fd6 100644 --- a/gcc/ada/libgnat/a-exexpr.adb +++ b/gcc/ada/libgnat/a-exexpr.adb @@ -197,15 +197,75 @@ package body Exception_Propagation is -- whose machine occurrence is Mo. The message is empty, the backtrace -- is empty too and the exception identity is Foreign_Exception. - -- Hooks called when entering/leaving an exception handler for a given - -- occurrence, aimed at handling the stack of active occurrences. The - -- calls are generated by gigi in tree_transform/N_Exception_Handler. + -- Hooks called when entering/leaving an exception handler for a + -- given occurrence. The calls are generated by gigi in + -- Exception_Handler_to_gnu_gcc. + + -- Begin_Handler_v1, called when entering an exception handler, + -- claims responsibility for the handler to release the + -- GCC_Exception occurrence. End_Handler_v1, called when + -- leaving the handler, releases the occurrence, unless the + -- occurrence is propagating further up, or the handler is + -- dynamically nested in the context of another handler that + -- claimed responsibility for releasing that occurrence. + + -- Responsibility is claimed by changing the Cleanup field to + -- Claimed_Cleanup, which enables claimed exceptions to be + -- recognized, and avoids accidental releases even by foreign + -- handlers. + + function Begin_Handler_v1 + (GCC_Exception : not null GCC_Exception_Access) + return System.Address; + pragma Export (C, Begin_Handler_v1, "__gnat_begin_handler_v1"); + -- Called when entering an exception handler. Claim + -- responsibility for releasing GCC_Exception, by setting the + -- cleanup/release function to Claimed_Cleanup, and return the + -- address of the previous cleanup/release function. + + procedure End_Handler_v1 + (GCC_Exception : not null GCC_Exception_Access; + Saved_Cleanup : System.Address; + Propagating_Exception : GCC_Exception_Access); + pragma Export (C, End_Handler_v1, "__gnat_end_handler_v1"); + -- Called when leaving an exception handler. Restore the + -- Saved_Cleanup in the GCC_Exception occurrence, and then release + -- it, unless it remains claimed by an enclosing handler, or + -- GCC_Exception and Propagating_Exception are the same + -- occurrence. Propagating_Exception could be either an + -- occurrence (re)raised within the handler of GCC_Exception, when + -- we're executing as an exceptional cleanup, or null, if we're + -- completing the handler of GCC_Exception normally. + + procedure Claimed_Cleanup + (Reason : Unwind_Reason_Code; + GCC_Exception : not null GCC_Exception_Access); + pragma Export (C, Claimed_Cleanup, "__gnat_claimed_cleanup"); + -- A do-nothing placeholder installed as GCC_Exception.Cleanup + -- while handling GCC_Exception, to claim responsibility for + -- releasing it, and to stop it from being accidentally released. + + -- The following are version 0 implementations of the version 1 + -- hooks above. They remain in place for compatibility with the + -- output of compilers that still use version 0, such as those + -- used during bootstrap. They are interoperable with the v1 + -- hooks, except that the older versions may malfunction when + -- handling foreign exceptions passed to Reraise_Occurrence. procedure Begin_Handler (GCC_Exception : not null GCC_Exception_Access); pragma Export (C, Begin_Handler, "__gnat_begin_handler"); + -- Called when entering an exception handler translated by an old + -- compiler. It does nothing. procedure End_Handler (GCC_Exception : GCC_Exception_Access); pragma Export (C, End_Handler, "__gnat_end_handler"); + -- Called when leaving an exception handler translated by an old + -- compiler. It releases GCC_Exception, unless it is null. It is + -- only ever null when the handler has a 'raise;' translated by a + -- v0-using compiler. The artificial handler variable passed to + -- End_Handler was set to null to tell End_Handler to refrain from + -- releasing the reraised exception. In v1 safer ways are used to + -- accomplish that. -------------------------------------------------------------------- -- Accessors to Basic Components of a GNAT Exception Data Pointer -- @@ -352,6 +412,128 @@ package body Exception_Propagation is end if; end Setup_Current_Excep; + ---------------------- + -- Begin_Handler_v1 -- + ---------------------- + + function Begin_Handler_v1 + (GCC_Exception : not null GCC_Exception_Access) + return System.Address is + Saved_Cleanup : constant System.Address := GCC_Exception.Cleanup; + begin + -- Claim responsibility for releasing this exception, and stop + -- others from releasing it. + GCC_Exception.Cleanup := Claimed_Cleanup'Address; + return Saved_Cleanup; + end Begin_Handler_v1; + + -------------------- + -- End_Handler_v1 -- + -------------------- + + procedure End_Handler_v1 + (GCC_Exception : not null GCC_Exception_Access; + Saved_Cleanup : System.Address; + Propagating_Exception : GCC_Exception_Access) is + begin + GCC_Exception.Cleanup := Saved_Cleanup; + -- Restore the Saved_Cleanup, so that it is either used to + -- release GCC_Exception below, or transferred to the next + -- handler of the Propagating_Exception occurrence. The + -- following test ensures that an occurrence is only released + -- once, even after reraises. + -- + -- The idea is that the GCC_Exception is not to be released + -- unless it had an unclaimed Cleanup when the handler started + -- (see Begin_Handler_v1 above), but if we propagate across its + -- handler a reraise of the same exception, we transfer to the + -- Propagating_Exception the responsibility for running the + -- Saved_Cleanup when its handler completes. + -- + -- This ownership transfer mechanism ensures safety, as in + -- single release and no dangling pointers, because there is no + -- way to hold on to the Machine_Occurrence of an + -- Exception_Occurrence: the only situations in which another + -- Exception_Occurrence gets the same Machine_Occurrence are + -- through Reraise_Occurrence, and plain reraise, and so we + -- have the following possibilities: + -- + -- - Reraise_Occurrence is handled within the running handler, + -- and so when completing the dynamically nested handler, we + -- must NOT release the exception. A Claimed_Cleanup upon + -- entry of the nested handler, installed when entering the + -- enclosing handler, ensures the exception will not be + -- released by the nested handler, but rather by the enclosing + -- handler. + -- + -- - Reraise_Occurrence/reraise escapes the running handler, + -- and we run as an exceptional cleanup for GCC_Exception. The + -- Saved_Cleanup was reinstalled, but since we're propagating + -- the same machine occurrence, we do not release it. Instead, + -- we transfer responsibility for releasing it to the eventual + -- handler of the propagating exception. + -- + -- - An unrelated exception propagates through the running + -- handler. We restored GCC_Exception.Saved_Cleanup above. + -- Since we're propagating a different exception, we proceed to + -- release GCC_Exception, unless Saved_Cleanup was + -- Claimed_Cleanup, because then we know we're not in the + -- outermost handler for GCC_Exception. + -- + -- - The handler completes normally, so it reinstalls the + -- Saved_Cleanup and runs it, unless it was Claimed_Cleanup. + -- If Saved_Cleanup is null, Unwind_DeleteException (currently) + -- has no effect, so we could skip it, but if it is ever + -- changed to do more in this case, we're ready for that, + -- calling it exactly once. + if Saved_Cleanup /= Claimed_Cleanup'Address + and then + Propagating_Exception /= GCC_Exception + then + declare + Current : constant EOA := Get_Current_Excep.all; + Cur_Occ : constant GCC_Exception_Access + := To_GCC_Exception (Current.Machine_Occurrence); + begin + -- If we are releasing the Machine_Occurrence of the current + -- exception, reset the access to it, so that it is no + -- longer accessible. + if Cur_Occ = GCC_Exception then + Current.Machine_Occurrence := System.Null_Address; + end if; + end; + Unwind_DeleteException (GCC_Exception); + end if; + end End_Handler_v1; + + --------------------- + -- Claimed_Cleanup -- + --------------------- + + procedure Claimed_Cleanup + (Reason : Unwind_Reason_Code; + GCC_Exception : not null GCC_Exception_Access) is + pragma Unreferenced (Reason); + pragma Unreferenced (GCC_Exception); + begin + -- This procedure should never run. If it does, it's either a + -- version 0 handler or a foreign handler, attempting to + -- release an exception while a version 1 handler that claimed + -- responsibility for releasing the exception remains still + -- active. This placeholder stops GCC_Exception from being + -- released by them. + + -- We could get away with just Null_Address instead, with + -- nearly the same effect, but with this placeholder we can + -- detect and report unexpected releases, and we can tell apart + -- a GCC_Exception without a Cleanup, from one with another + -- active handler, so as to still call Unwind_DeleteException + -- exactly once: currently, Unwind_DeleteException does nothing + -- when the Cleanup is null, but should it ever be changed to + -- do more, we'll still be safe. + null; + end Claimed_Cleanup; + ------------------- -- Begin_Handler -- ------------------- -- cgit v1.1 From ab20d992c828450ce4aa869e8995ef2924740fd0 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Sat, 10 Aug 2019 11:59:17 +0200 Subject: Assorted ChangeLog cleanups. From-SVN: r274250 --- gcc/ada/ChangeLog | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index bcfc8cc..cb3892f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,4 +1,4 @@ -2019-08-02 Alexandre Oliva +2019-08-02 Alexandre Oliva * libgnat/a-exexpr.adb (Begin_Handler_v1, End_Handler_v1): New. (Claimed_Cleanup): New. @@ -281,7 +281,7 @@ 2019-07-22 Ed Schonberg - * freeze.adb (Freeze_Fixed_Point_Type): When freezing a + * freeze.adb (Freeze_Fixed_Point_Type): When freezing a fixed-point subtype, check whether the parent type declarastion includes an aspect specification for the 'Small type attribute, and inherit the specified value. @@ -1945,7 +1945,7 @@ * libgnat/g-traceb.ads, libgnat/g-traceb.adb (Call_Chain): New function. -2019-07-04 James Clarke +2019-07-04 James Clarke * libgnarl/s-osinte__kfreebsd-gnu.ads (clockid_t): Make type definition public. @@ -2508,7 +2508,7 @@ 2019-07-03 Ed Schonberg - * inline.adb (Make_Loop_Labels_Unique): New procedure to modify + * inline.adb (Make_Loop_Labels_Unique): New procedure to modify the source code of subprograms that are inlined by the front-end, to prevent accidental duplication between loop labels in the inlined code and the code surrounding the inlined call. -- cgit v1.1 From 68c8d72a1aa31d750ddeb6a0eb3f472f1498a154 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 12 Aug 2019 08:58:46 +0000 Subject: [Ada] Fix incorrect Do_Range_Check on type conversion This gets rid of another leak of the Do_Range_Check flag to the back-end which is specific to expression functions. No functional changes. 2019-08-12 Eric Botcazou gcc/ada/ * checks.adb (Activate_Range_Check): Remove redundant argument. (Generate_Range_Check): Likewise. (Apply_Float_Conversion_Check): Reset the Do_Range_Check flag on entry and remove redundant condition. From-SVN: r274279 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/checks.adb | 11 ++++++++--- 2 files changed, 15 insertions(+), 3 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index cb3892f..749d96a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-08-12 Eric Botcazou + + * checks.adb (Activate_Range_Check): Remove redundant argument. + (Generate_Range_Check): Likewise. + (Apply_Float_Conversion_Check): Reset the Do_Range_Check flag on + entry and remove redundant condition. + 2019-08-02 Alexandre Oliva * libgnat/a-exexpr.adb (Begin_Handler_v1, End_Handler_v1): New. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 708bd9e..813ffec 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -445,7 +445,7 @@ package body Checks is procedure Activate_Range_Check (N : Node_Id) is begin - Set_Do_Range_Check (N, True); + Set_Do_Range_Check (N); Possible_Local_Raise (N, Standard_Constraint_Error); end Activate_Range_Check; @@ -2031,6 +2031,12 @@ package body Checks is return; end if; + -- Here we will generate an explicit range check, so we don't want to + -- set the Do_Range check flag, since the range check is taken care of + -- by the code we will generate. + + Set_Do_Range_Check (Ck_Node, False); + if not Compile_Time_Known_Value (LB) or not Compile_Time_Known_Value (HB) then @@ -2079,7 +2085,6 @@ package body Checks is 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)); @@ -6936,7 +6941,7 @@ package body Checks is -- flag set, we do not want to generate the explicit range check code. if GNATprove_Mode or else not Expander_Active then - Set_Do_Range_Check (N, True); + Set_Do_Range_Check (N); return; end if; -- cgit v1.1 From 13931a38fcab143344c90378c3688d089a4efbec Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 12 Aug 2019 08:58:52 +0000 Subject: [Ada] Fix missing range check for In/Out parameter with -gnatVa This plugs another small loophole in the front-end which fails to generate a range check for a scalar In/Out parameter when -gnatVa is specified. This also fixes a few more leaks of the Do_Range_Check flag on actual parameters, both in regular and -gnatVa modes, as well as a leak specific to expression function in -gnatp mode. 2019-08-12 Eric Botcazou gcc/ada/ * checks.adb (Insert_Valid_Check): Reset the Do_Range_Check flag on the validated object. * exp_ch6.adb (Add_Call_By_Copy_Code): Reset the Do_Range_Check flag on the actual here, as well as on the Expression if the actual is a N_Type_Conversion node. (Add_Validation_Call_By_Copy_Code): Generate the incoming range check if needed and reset the Do_Range_Check flag on the Expression if the actual is a N_Type_Conversion node. (Expand_Actuals): Do not reset the Do_Range_Check flag here. Generate the incoming range check for In parameters here instead of... (Expand_Call_Helper): ...here. Remove redudant condition. * sem_res.adb (Resolve_Actuals): Use local variable A_Typ and remove obsolete comments. (Resolve_Type_Conversion): Do not force the Do_Range_Check flag on the operand if range checks are suppressed. gcc/testsuite/ * gnat.dg/range_check6.adb: New testcase. From-SVN: r274280 --- gcc/ada/ChangeLog | 19 +++++++++++++++++++ gcc/ada/checks.adb | 8 +++++++- gcc/ada/exp_ch6.adb | 49 ++++++++++++++++++++++++++++--------------------- gcc/ada/sem_res.adb | 22 ++++++++-------------- 4 files changed, 62 insertions(+), 36 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 749d96a..7c7aa83 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,24 @@ 2019-08-12 Eric Botcazou + * checks.adb (Insert_Valid_Check): Reset the Do_Range_Check flag + on the validated object. + * exp_ch6.adb (Add_Call_By_Copy_Code): Reset the Do_Range_Check + flag on the actual here, as well as on the Expression if the + actual is a N_Type_Conversion node. + (Add_Validation_Call_By_Copy_Code): Generate the incoming range + check if needed and reset the Do_Range_Check flag on the + Expression if the actual is a N_Type_Conversion node. + (Expand_Actuals): Do not reset the Do_Range_Check flag here. + Generate the incoming range check for In parameters here instead + of... + (Expand_Call_Helper): ...here. Remove redudant condition. + * sem_res.adb (Resolve_Actuals): Use local variable A_Typ and + remove obsolete comments. + (Resolve_Type_Conversion): Do not force the Do_Range_Check flag + on the operand if range checks are suppressed. + +2019-08-12 Eric Botcazou + * checks.adb (Activate_Range_Check): Remove redundant argument. (Generate_Range_Check): Likewise. (Apply_Float_Conversion_Check): Reset the Do_Range_Check flag on diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 813ffec..5d8efce 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -7588,8 +7588,12 @@ package body Checks is Suppress => Validity_Check); Set_Validated_Object (Var_Id, New_Copy_Tree (Exp)); + + -- Reset the Do_Range_Check flag so it doesn't leak elsewhere + + Set_Do_Range_Check (Validated_Object (Var_Id), False); + Rewrite (Exp, New_Occurrence_Of (Var_Id, Loc)); - PV := New_Occurrence_Of (Var_Id, Loc); -- Copy the Do_Range_Check flag over to the new Exp, so it doesn't -- get lost. Floating point types are handled elsewhere. @@ -7598,6 +7602,8 @@ package body Checks is Set_Do_Range_Check (Exp, Do_Range_Check (Original_Node (Exp))); end if; + PV := New_Occurrence_Of (Var_Id, Loc); + -- Otherwise the expression does not denote a variable. Force its -- evaluation by capturing its value in a constant. Generate: diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index f38dd67..3f2d0e3 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -1295,7 +1295,14 @@ package body Exp_Ch6 is Indic := New_Occurrence_Of (F_Typ, Loc); end if; + -- The new code will be properly analyzed below and the setting of + -- the Do_Range_Check flag recomputed so remove the obsolete one. + + Set_Do_Range_Check (Actual, False); + if Nkind (Actual) = N_Type_Conversion then + Set_Do_Range_Check (Expression (Actual), False); + V_Typ := Etype (Expression (Actual)); -- If the formal is an (in-)out parameter, capture the name @@ -1689,6 +1696,20 @@ package body Exp_Ch6 is Var_Id : Entity_Id; begin + -- Generate range check if required + + if Do_Range_Check (Actual) then + Generate_Range_Check (Actual, E_Formal, CE_Range_Check_Failed); + end if; + + -- If there is a type conversion in the actual, it will be reinstated + -- below, the new instance will be properly analyzed and the setting + -- of the Do_Range_Check flag recomputed so remove the obsolete one. + + if Nkind (Actual) = N_Type_Conversion then + Set_Do_Range_Check (Expression (Actual), False); + end if; + -- Copy the value of the validation variable back into the object -- being validated. @@ -2073,14 +2094,6 @@ package body Exp_Ch6 is (Ekind (Formal) = E_In_Out_Parameter and then not In_Subrange_Of (E_Actual, E_Formal))) then - -- Perhaps the setting back to False should be done within - -- Add_Call_By_Copy_Code, since it could get set on other - -- cases occurring above??? - - if Do_Range_Check (Actual) then - Set_Do_Range_Check (Actual, False); - end if; - Add_Call_By_Copy_Code; end if; @@ -2194,6 +2207,12 @@ package body Exp_Ch6 is -- Processing for IN parameters else + -- Generate range check if required + + if Do_Range_Check (Actual) then + Generate_Range_Check (Actual, E_Formal, CE_Range_Check_Failed); + end if; + -- For IN parameters in the bit-packed array case, we expand an -- indexed component (the circuit in Exp_Ch4 deliberately left -- indexed components appearing as actuals untouched, so that @@ -3054,16 +3073,6 @@ package body Exp_Ch6 is Actual := First_Actual (Call_Node); Param_Count := 1; while Present (Formal) loop - - -- Generate range check if required - - if Do_Range_Check (Actual) - and then Ekind (Formal) = E_In_Parameter - then - Generate_Range_Check - (Actual, Etype (Formal), CE_Range_Check_Failed); - end if; - -- Prepare to examine current entry Prev := Actual; @@ -3582,9 +3591,7 @@ package body Exp_Ch6 is -- or IN OUT parameter. We do reset the Is_Known_Valid flag -- since the subprogram could have returned in invalid value. - if Ekind_In (Formal, E_Out_Parameter, E_In_Out_Parameter) - and then Is_Assignable (Ent) - then + if Is_Assignable (Ent) then Sav := Last_Assignment (Ent); Kill_Current_Values (Ent); Set_Last_Assignment (Ent, Sav); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index b668a51..8162b8e 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -4517,7 +4517,7 @@ package body Sem_Res is end if; end if; - if Etype (A) = Any_Type then + if A_Typ = Any_Type then Set_Etype (N, Any_Type); return; end if; @@ -4539,18 +4539,10 @@ package body Sem_Res is -- Apply required constraint checks - -- Gigi looks at the check flag and uses the appropriate types. - -- For now since one flag is used there is an optimization - -- which might not be done in the IN OUT case since Gigi does - -- not do any analysis. More thought required about this ??? - - -- In fact is this comment obsolete??? doesn't the expander now - -- generate all these tests anyway??? - - if Is_Scalar_Type (Etype (A)) then + if Is_Scalar_Type (A_Typ) then Apply_Scalar_Range_Check (A, F_Typ); - elsif Is_Array_Type (Etype (A)) then + elsif Is_Array_Type (A_Typ) then Apply_Length_Check (A, F_Typ); elsif Is_Record_Type (F_Typ) @@ -4624,9 +4616,8 @@ package body Sem_Res is Apply_Scalar_Range_Check (Expression (A), Etype (Expression (A)), A_Typ); - -- In addition, the returned value of the parameter must - -- satisfy the bounds of the object type (see comment - -- below). + -- In addition the return value must meet the constraints + -- of the object type (see the comment below). Apply_Scalar_Range_Check (A, A_Typ, F_Typ); @@ -4650,6 +4641,7 @@ package body Sem_Res is and then Ekind (F) = E_Out_Parameter then Apply_Length_Check (A, F_Typ); + else Apply_Range_Check (A, A_Typ, F_Typ); end if; @@ -11757,6 +11749,8 @@ package body Sem_Res is and then (Is_Fixed_Point_Type (Operand_Typ) or else (not GNATprove_Mode and then Is_Floating_Point_Type (Operand_Typ))) + and then not Range_Checks_Suppressed (Target_Typ) + and then not Range_Checks_Suppressed (Operand_Typ) then Set_Do_Range_Check (Operand); end if; -- cgit v1.1 From 4d7d2736587ecfb99b513645dda7460f9100f69c Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 12 Aug 2019 08:58:57 +0000 Subject: [Ada] Add special bypass for obsolete code pattern This change prevents the analysis phase of the front-end from setting the Do_Range_Check flag in the very peculiar case of the source of a conversion whose result is passed by reference to a "valued procedure", because the expansion phase would not be able to generate the check. This pattern appears in the ancient DEC Starlet package and it doesn't seem to be useful at this point to change the expander to deal with it, so instead the analysis phase is adjusted. Morever the compiler already issues a warning in this case so this is probably good enough. 2019-08-12 Eric Botcazou gcc/ada/ * sem_res.adb: Add with & use clause for Sem_Mech and alphabetize. (Resolve_Actuals): Do not apply a scalar range check for the source of a conversion whose result is passed by reference to a valued procedure. From-SVN: r274281 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/sem_res.adb | 26 +++++++++++++++++++------- 2 files changed, 27 insertions(+), 7 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7c7aa83..315b4f6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,13 @@ 2019-08-12 Eric Botcazou + * sem_res.adb: Add with & use clause for Sem_Mech and + alphabetize. + (Resolve_Actuals): Do not apply a scalar range check for the + source of a conversion whose result is passed by reference to a + valued procedure. + +2019-08-12 Eric Botcazou + * checks.adb (Insert_Valid_Check): Reset the Do_Range_Check flag on the validated object. * exp_ch6.adb (Add_Call_By_Copy_Code): Reset the Do_Range_Check diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 8162b8e..ecd8bc0 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -30,9 +30,9 @@ with Debug_A; use Debug_A; with Einfo; use Einfo; with Errout; use Errout; with Expander; use Expander; -with Exp_Disp; use Exp_Disp; with Exp_Ch6; use Exp_Ch6; with Exp_Ch7; use Exp_Ch7; +with Exp_Disp; use Exp_Disp; with Exp_Tss; use Exp_Tss; with Exp_Util; use Exp_Util; with Freeze; use Freeze; @@ -51,12 +51,12 @@ with Restrict; use Restrict; with Rident; use Rident; with Rtsfind; use Rtsfind; with Sem; use Sem; -with Sem_Aux; use Sem_Aux; with Sem_Aggr; use Sem_Aggr; with Sem_Attr; use Sem_Attr; +with Sem_Aux; use Sem_Aux; with Sem_Cat; use Sem_Cat; -with Sem_Ch4; use Sem_Ch4; with Sem_Ch3; use Sem_Ch3; +with Sem_Ch4; use Sem_Ch4; with Sem_Ch6; use Sem_Ch6; with Sem_Ch8; use Sem_Ch8; with Sem_Ch13; use Sem_Ch13; @@ -67,9 +67,9 @@ with Sem_Elab; use Sem_Elab; with Sem_Elim; use Sem_Elim; with Sem_Eval; use Sem_Eval; with Sem_Intr; use Sem_Intr; -with Sem_Util; use Sem_Util; -with Targparm; use Targparm; +with Sem_Mech; use Sem_Mech; with Sem_Type; use Sem_Type; +with Sem_Util; use Sem_Util; with Sem_Warn; use Sem_Warn; with Sinfo; use Sinfo; with Sinfo.CN; use Sinfo.CN; @@ -77,6 +77,7 @@ with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; with Style; use Style; +with Targparm; use Targparm; with Tbuild; use Tbuild; with Uintp; use Uintp; with Urealp; use Urealp; @@ -4613,8 +4614,19 @@ package body Sem_Res is if Nkind (A) = N_Type_Conversion then if Is_Scalar_Type (A_Typ) then - Apply_Scalar_Range_Check - (Expression (A), Etype (Expression (A)), A_Typ); + + -- Special case here tailored to Exp_Ch6.Is_Legal_Copy, + -- which would prevent the check from being generated. + -- This is for Starlet only though, so long obsolete. + + if Mechanism (F) = By_Reference + and then Is_Valued_Procedure (Nam) + then + null; + else + Apply_Scalar_Range_Check + (Expression (A), Etype (Expression (A)), A_Typ); + end if; -- In addition the return value must meet the constraints -- of the object type (see the comment below). -- cgit v1.1 From 43eb2bb6967ffd6d9b9fadfa606c177671c28261 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 12 Aug 2019 08:59:02 +0000 Subject: [Ada] Plug small loophole in Discrete_Range_Check This routine would not return if range checks are suppressed. 2019-08-12 Eric Botcazou gcc/ada/ * exp_ch4.adb (Discrete_Range_Check): Return if checks are suppressed. From-SVN: r274282 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/exp_ch4.adb | 19 ++++++++++++++++++- 2 files changed, 23 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 315b4f6..df19f1b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2019-08-12 Eric Botcazou + * exp_ch4.adb (Discrete_Range_Check): Return if checks are + suppressed. + +2019-08-12 Eric Botcazou + * sem_res.adb: Add with & use clause for Sem_Mech and alphabetize. (Resolve_Actuals): Do not apply a scalar range check for the diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index e4dc06b..425c505 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -10969,7 +10969,9 @@ package body Exp_Ch4 is -- Discrete_Range_Check -- -------------------------- - -- Case of conversions to a discrete type + -- Case of conversions to a discrete type. We let Generate_Range_Check + -- do the heavy lifting, after converting a fixed-point operand to an + -- appropriate integer type. procedure Discrete_Range_Check is Expr : Node_Id; @@ -10984,6 +10986,21 @@ package body Exp_Ch4 is Expr := Expression (N); + -- Nothing to do if range checks suppressed + + if Range_Checks_Suppressed (Target_Type) then + return; + end if; + + -- Nothing to do if expression is an entity on which checks have been + -- suppressed. + + if Is_Entity_Name (Expr) + and then Range_Checks_Suppressed (Entity (Expr)) + then + return; + end if; + -- Before we do a range check, we have to deal with treating -- a fixed-point operand as an integer. The way we do this -- is simply to do an unchecked conversion to an appropriate -- cgit v1.1 From 96a8b7050beeb1a28d0e2c2a8d3e841ea38d450c Mon Sep 17 00:00:00 2001 From: Jerome Lambourg Date: Mon, 12 Aug 2019 08:59:08 +0000 Subject: [Ada] VxWorks: call s-tpopsp.Self only when needed 2019-08-12 Jerome Lambourg gcc/ada/ * libgnarl/s-taprop__vxworks.adb (Abort_Handler): Only call s-tpopsp.Self when actually needed. From-SVN: r274283 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/libgnarl/s-taprop__vxworks.adb | 7 ++++++- 2 files changed, 11 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index df19f1b..b656a02 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-12 Jerome Lambourg + + * libgnarl/s-taprop__vxworks.adb (Abort_Handler): Only call + s-tpopsp.Self when actually needed. + 2019-08-12 Eric Botcazou * exp_ch4.adb (Discrete_Range_Check): Return if checks are diff --git a/gcc/ada/libgnarl/s-taprop__vxworks.adb b/gcc/ada/libgnarl/s-taprop__vxworks.adb index 80a7290..6ef0a9b 100644 --- a/gcc/ada/libgnarl/s-taprop__vxworks.adb +++ b/gcc/ada/libgnarl/s-taprop__vxworks.adb @@ -192,7 +192,10 @@ package body System.Task_Primitives.Operations is procedure Abort_Handler (signo : Signal) is pragma Unreferenced (signo); - Self_ID : constant Task_Id := Self; + -- Do not call Self at this point as we're in a signal handler + -- and it may not be available, in particular on targets where we + -- support ZCX and where we don't do anything here anyway. + Self_ID : Task_Id; Old_Set : aliased sigset_t; Unblocked_Mask : aliased sigset_t; Result : int; @@ -208,6 +211,8 @@ package body System.Task_Primitives.Operations is return; end if; + Self_ID := Self; + if Self_ID.Deferral_Level = 0 and then Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level and then not Self_ID.Aborting -- cgit v1.1 From 935b02aea97d8d2aa40e65e908228c4666cb1803 Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Mon, 12 Aug 2019 08:59:13 +0000 Subject: [Ada] Extended traversal subprograms for GNATprove GNATprove needs traversal subprograms that do not simply traverse syntactic nodes like Atree.Traverse_Func and Atree.Traverse_Proc, but also traverse semantic nodes which are logically children of the nodes. Now available through Sem_Util.Traverse_More_Func and Sem_Util.Traverse_More_Proc. There is no impact on compilation. 2019-08-12 Yannick Moy gcc/ada/ * sem_util.adb, sem_util.ads (Traverse_More_Func, Traverse_More_Proc): New traversal subprograms. From-SVN: r274284 --- gcc/ada/ChangeLog | 5 ++ gcc/ada/sem_util.adb | 200 ++++++++++++++++++++++++++++++++++++++++++++++++++- gcc/ada/sem_util.ads | 17 +++++ 3 files changed, 221 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b656a02..2f3ec7b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-12 Yannick Moy + + * sem_util.adb, sem_util.ads (Traverse_More_Func, + Traverse_More_Proc): New traversal subprograms. + 2019-08-12 Jerome Lambourg * libgnarl/s-taprop__vxworks.adb (Abort_Handler): Only call diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index f18eb0f..acc257c 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -26,7 +26,6 @@ with Treepr; -- ???For debugging code below with Aspects; use Aspects; -with Atree; use Atree; with Casing; use Casing; with Checks; use Checks; with Debug; use Debug; @@ -25437,6 +25436,205 @@ package body Sem_Util is end if; end Transfer_Entities; + ------------------------ + -- Traverse_More_Func -- + ------------------------ + + function Traverse_More_Func (Node : Node_Id) return Traverse_Final_Result is + + Processing_Itype : Boolean := False; + -- Set to True while traversing the nodes under an Itype, to prevent + -- looping on Itype handling during that traversal. + + function Process_More (N : Node_Id) return Traverse_Result; + -- Wrapper over the Process callback to handle parts of the AST that + -- are not normally traversed as syntactic children. + + function Traverse_Rec (N : Node_Id) return Traverse_Final_Result; + -- Main recursive traversal implemented as an instantiation of + -- Traverse_Func over a modified Process callback. + + ------------------ + -- Process_More -- + ------------------ + + function Process_More (N : Node_Id) return Traverse_Result is + + procedure Traverse_More (N : Node_Id; + Res : in out Traverse_Result); + procedure Traverse_More (L : List_Id; + Res : in out Traverse_Result); + -- Traverse a node or list and update the traversal result to value + -- Abandon when needed. + + ------------------- + -- Traverse_More -- + ------------------- + + procedure Traverse_More (N : Node_Id; + Res : in out Traverse_Result) + is + begin + -- Do not process any more nodes if Abandon was reached + + if Res = Abandon then + return; + end if; + + if Traverse_Rec (N) = Abandon then + Res := Abandon; + end if; + end Traverse_More; + + procedure Traverse_More (L : List_Id; + Res : in out Traverse_Result) + is + N : Node_Id := First (L); + + begin + -- Do not process any more nodes if Abandon was reached + + if Res = Abandon then + return; + end if; + + while Present (N) loop + Traverse_More (N, Res); + Next (N); + end loop; + end Traverse_More; + + -- Local variables + + Node : Node_Id; + Result : Traverse_Result; + + -- Start of processing for Process_More + + begin + -- Initial callback to Process. Return immediately on Skip/Abandon. + -- Otherwise update the value of Node for further processing of + -- non-syntactic children. + + Result := Process (N); + + case Result is + when OK => Node := N; + when OK_Orig => Node := Original_Node (N); + when Skip => return Skip; + when Abandon => return Abandon; + end case; + + -- Process the relevant semantic children which are a logical part of + -- the AST under this node before returning for the processing of + -- syntactic children. + + -- Start with all non-syntactic lists of action nodes + + case Nkind (Node) is + when N_Component_Association => + Traverse_More (Loop_Actions (Node), Result); + + when N_Elsif_Part => + Traverse_More (Condition_Actions (Node), Result); + + when N_Short_Circuit => + Traverse_More (Actions (Node), Result); + + when N_Case_Expression_Alternative => + Traverse_More (Actions (Node), Result); + + when N_Iteration_Scheme => + Traverse_More (Condition_Actions (Node), Result); + + when N_If_Expression => + Traverse_More (Then_Actions (Node), Result); + Traverse_More (Else_Actions (Node), Result); + + -- Various nodes have a field Actions as a syntactic node, + -- so it will be traversed in the regular syntactic traversal. + + when N_Compilation_Unit_Aux + | N_Compound_Statement + | N_Expression_With_Actions + | N_Freeze_Entity + => + null; + + when others => + null; + end case; + + -- Then process unattached nodes which come from Itypes. This only + -- concerns currently ranges of scalar (possibly as index) types. + -- This traversal is protected against looping with Processing_Itype. + + if not Processing_Itype + and then Nkind (Node) in N_Has_Etype + and then Present (Etype (Node)) + and then Is_Itype (Etype (Node)) + then + declare + Typ : constant Entity_Id := Etype (Node); + begin + Processing_Itype := True; + + case Ekind (Typ) is + when Scalar_Kind => + Traverse_More (Scalar_Range (Typ), Result); + + when Array_Kind => + declare + Index : Node_Id := First_Index (Typ); + Rng : Node_Id; + begin + while Present (Index) loop + if Nkind (Index) in N_Has_Entity then + Rng := Scalar_Range (Entity (Index)); + else + Rng := Index; + end if; + + Traverse_More (Rng, Result); + Next_Index (Index); + end loop; + end; + when others => + null; + end case; + + Processing_Itype := False; + end; + end if; + + return Result; + end Process_More; + + -- Define Traverse_Rec as a renaming of the instantiation, as an + -- instantiation cannot complete a previous spec. + + function Traverse_Recursive is new Traverse_Func (Process_More); + function Traverse_Rec (N : Node_Id) return Traverse_Final_Result + renames Traverse_Recursive; + + -- Start of processing for Traverse_More_Func + + begin + return Traverse_Rec (Node); + end Traverse_More_Func; + + ------------------------ + -- Traverse_More_Proc -- + ------------------------ + + procedure Traverse_More_Proc (Node : Node_Id) is + function Traverse is new Traverse_More_Func (Process); + Discard : Traverse_Final_Result; + pragma Warnings (Off, Discard); + begin + Discard := Traverse (Node); + end Traverse_More_Proc; + ----------------------- -- Type_Access_Level -- ----------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 35ef111..478f570 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -25,6 +25,7 @@ -- Package containing utility procedures used throughout the semantics +with Atree; use Atree; with Einfo; use Einfo; with Exp_Tss; use Exp_Tss; with Namet; use Namet; @@ -2811,6 +2812,22 @@ package Sem_Util is -- Move a list of entities from one scope to another, and recompute -- Is_Public based upon the new scope. + generic + with function Process (N : Node_Id) return Traverse_Result is <>; + function Traverse_More_Func (Node : Node_Id) return Traverse_Final_Result; + -- This is a version of Atree.Traverse_Func that not only traverses + -- syntactic children of nodes, but also semantic children which are + -- logically children of the node. This concerns currently lists of + -- action nodes and ranges under Itypes, both inserted by the compiler. + + generic + with function Process (N : Node_Id) return Traverse_Result is <>; + procedure Traverse_More_Proc (Node : Node_Id); + pragma Inline (Traverse_More_Proc); + -- This is the same as Traverse_More_Func except that no result is + -- returned, i.e. Traverse_More_Func is called and the result is simply + -- discarded. + function Type_Access_Level (Typ : Entity_Id) return Uint; -- Return the accessibility level of Typ -- cgit v1.1 From 1361a4fbe10d119c76339f06992ac60de54f124d Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 12 Aug 2019 08:59:18 +0000 Subject: [Ada] Fix leak of Do_Range_Check flag in -gnatVa mode This fixes a small glitch in Insert_Valid_Check, which needs to propagate the Do_Range_Check flag onto the rewritten expression, but uses its Original_Node as the source of the copy. Now Original_Node does not necessarily point to the node that was just rewritten, but to the ultimately original node, which is not the same node if the expression was rewritten multiple times. The end result is that a stalled Do_Range_Check flag can be wrongly resintated and leak to the code generator. 2019-08-12 Eric Botcazou gcc/ada/ * checks.adb (Insert_Valid_Check): Do not retrieve the Do_Range_Check flag from the Original_Node but from the Validated_Object. Remove useless bypass for floating-point types. gcc/testsuite/ * gnat.dg/range_check7.adb: New testcase. From-SVN: r274285 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/checks.adb | 13 +++++-------- 2 files changed, 12 insertions(+), 8 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2f3ec7b..362efba 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-08-12 Eric Botcazou + + * checks.adb (Insert_Valid_Check): Do not retrieve the + Do_Range_Check flag from the Original_Node but from the + Validated_Object. Remove useless bypass for floating-point + types. + 2019-08-12 Yannick Moy * sem_util.adb, sem_util.ads (Traverse_More_Func, diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 5d8efce..470ea3f 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -7589,17 +7589,14 @@ package body Checks is Set_Validated_Object (Var_Id, New_Copy_Tree (Exp)); - -- Reset the Do_Range_Check flag so it doesn't leak elsewhere - - Set_Do_Range_Check (Validated_Object (Var_Id), False); - Rewrite (Exp, New_Occurrence_Of (Var_Id, Loc)); - -- Copy the Do_Range_Check flag over to the new Exp, so it doesn't - -- get lost. Floating point types are handled elsewhere. + -- Move the Do_Range_Check flag over to the new Exp so it doesn't + -- get lost and doesn't leak elsewhere. - if not Is_Floating_Point_Type (Typ) then - Set_Do_Range_Check (Exp, Do_Range_Check (Original_Node (Exp))); + if Do_Range_Check (Validated_Object (Var_Id)) then + Set_Do_Range_Check (Exp); + Set_Do_Range_Check (Validated_Object (Var_Id), False); end if; PV := New_Occurrence_Of (Var_Id, Loc); -- cgit v1.1 From 5aa76fe17be6f6c222d16d5a51f60ed7755c6ad6 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 12 Aug 2019 08:59:23 +0000 Subject: [Ada] Sprint: minor comment tweak 2019-08-12 Eric Botcazou gcc/ada/ * sprint.ads: Minor comment tweak. From-SVN: r274286 --- gcc/ada/ChangeLog | 4 ++++ gcc/ada/sprint.ads | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 362efba..b05d7c8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,9 @@ 2019-08-12 Eric Botcazou + * sprint.ads: Minor comment tweak. + +2019-08-12 Eric Botcazou + * checks.adb (Insert_Valid_Check): Do not retrieve the Do_Range_Check flag from the Original_Node but from the Validated_Object. Remove useless bypass for floating-point diff --git a/gcc/ada/sprint.ads b/gcc/ada/sprint.ads index 11a552f..c510ac6 100644 --- a/gcc/ada/sprint.ads +++ b/gcc/ada/sprint.ads @@ -48,8 +48,8 @@ package Sprint is -- Allocator new xxx [storage_pool = xxx] -- Cleanup action at end procedure name; - -- Conversion wi Float_Truncate target^(source) -- Convert wi Conversion_OK target?(source) + -- Convert wi Float_Truncate target^(source) -- Convert wi Rounded_Result target@(source) -- Divide wi Treat_Fixed_As_Integer x #/ y -- Divide wi Rounded_Result x @/ y -- cgit v1.1 From 4e896dad492f7484cc239f105454713a3c4596eb Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 12 Aug 2019 08:59:28 +0000 Subject: [Ada] Eliminate redundant range checks on conversions This gets rid of redundant range checks generated in 5 out of the 9 cases of scalar conversions, i.e. (integer, fixed-point, floating-point) converted to (integer, fixed-point, floating-point). The problem is that the Real_Range_Check routine rewrites the conversion node into a conversion to the base type so, when its parent node is analyzed, a new conversion to the subtype may be introduced, depending on the context, giving rise to a second range check against the subtype bounds. This change makes Real_Range_Check rewrite the expression of the conversion node instead of the node, so that the type of the node is preserved and no new conversion is introduced. As a matter of fact, this is exactly what happens in the float-to-float case which goes to the Generate_Range_Check circuit instead and does not suffer from the duplication of range checks. For the following procedure, the compiler must now generate exactly one range check per nested function: procedure P is type I1 is new Integer range -100 .. 100; type I2 is new Integer range -200 .. 200; type D1 is delta 0.5 range -100.0 .. 100.0; type D2 is delta 0.5 range -200.0 .. 200.0; type F1 is new Long_Float range -100.0 .. 100.0; type F2 is new Long_Float range -200.0 .. 200.0; function Conv (A : I2) return I1 is begin return I1 (A); end; function Conv (A : D2) return I1 is begin return I1 (A); end; function Conv (A : F2) return I1 is begin return I1 (A); end; function Conv (A : I2) return D1 is begin return D1 (A); end; function Conv (A : D2) return D1 is begin return D1 (A); end; function Conv (A : F2) return D1 is begin return D1 (A); end; function Conv (A : I2) return F1 is begin return F1 (A); end; function Conv (A : D2) return F1 is begin return F1 (A); end; function Conv (A : F2) return F1 is begin return F1 (A); end; begin null; end; 2019-08-12 Eric Botcazou gcc/ada/ * exp_ch4.adb (Real_Range_Check): Do not rewrite the conversion node but its expression instead, after having fetched its current value. Clear the Do_Range_Check flag on entry. Return early for a rewritten float-to-float conversion. Remove redundant local variable. Suppress all checks when inserting the temporary and do not reanalyze the node. From-SVN: r274287 --- gcc/ada/ChangeLog | 9 +++++ gcc/ada/exp_ch4.adb | 97 +++++++++++++++++++++++++++++------------------------ 2 files changed, 62 insertions(+), 44 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b05d7c8..d30e8e9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,14 @@ 2019-08-12 Eric Botcazou + * exp_ch4.adb (Real_Range_Check): Do not rewrite the conversion + node but its expression instead, after having fetched its + current value. Clear the Do_Range_Check flag on entry. Return + early for a rewritten float-to-float conversion. Remove + redundant local variable. Suppress all checks when inserting + the temporary and do not reanalyze the node. + +2019-08-12 Eric Botcazou + * sprint.ads: Minor comment tweak. 2019-08-12 Eric Botcazou diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 425c505..43be9c9 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -11229,12 +11229,12 @@ package body Exp_Ch4 is -- Tnn : typ'Base := typ'Base (x); -- [constraint_error when Tnn < typ'First or else Tnn > typ'Last] - -- Tnn + -- typ (Tnn) -- This is necessary when there is a conversion of integer to float or -- to fixed-point to ensure that the correct checks are made. It is not - -- necessary for float to float where it is enough to simply set the - -- Do_Range_Check flag. + -- necessary for the float-to-float case where it is enough to just set + -- the Do_Range_Check flag on the expression. procedure Real_Range_Check is Btyp : constant Entity_Id := Base_Type (Target_Type); @@ -11246,6 +11246,7 @@ package body Exp_Ch4 is Hi_Val : Node_Id; Lo_Arg : Node_Id; Lo_Val : Node_Id; + Expr : Entity_Id; Tnn : Entity_Id; begin @@ -11255,6 +11256,12 @@ package body Exp_Ch4 is return; end if; + Expr := Expression (N); + + -- Clear the flag once for all + + Set_Do_Range_Check (Expr, False); + -- Nothing to do if range checks suppressed, or target has the same -- range as the base type (or is the base type). @@ -11263,22 +11270,24 @@ package body Exp_Ch4 is and then Hi = Type_High_Bound (Btyp)) then - -- Unset the range check flag on the current value of - -- Expression (N), since the captured Operand may have - -- been rewritten (such as for the case of a conversion - -- to a fixed-point type). - - Set_Do_Range_Check (Expression (N), False); return; end if; -- Nothing to do if expression is an entity on which checks have been -- suppressed. - if Is_Entity_Name (Operand) - and then Range_Checks_Suppressed (Entity (Operand)) + if Is_Entity_Name (Expr) + and then Range_Checks_Suppressed (Entity (Expr)) + then + return; + end if; + + -- Nothing to do if expression was rewritten into a float-to-float + -- conversion, since this kind of conversions is handled elsewhere. + + if Is_Floating_Point_Type (Etype (Expr)) + and then Is_Floating_Point_Type (Target_Type) then - Set_Do_Range_Check (Expression (N), False); return; end if; @@ -11288,12 +11297,12 @@ package body Exp_Ch4 is -- not trust it to be in range (might be infinite) declare - S_Lo : constant Node_Id := Type_Low_Bound (Operand_Type); - S_Hi : constant Node_Id := Type_High_Bound (Operand_Type); + S_Lo : constant Node_Id := Type_Low_Bound (Etype (Expr)); + S_Hi : constant Node_Id := Type_High_Bound (Etype (Expr)); begin - if (not Is_Floating_Point_Type (Operand_Type) - or else Is_Constrained (Operand_Type)) + if (not Is_Floating_Point_Type (Etype (Expr)) + or else Is_Constrained (Etype (Expr))) and then Compile_Time_Known_Value (S_Lo) and then Compile_Time_Known_Value (S_Hi) and then Compile_Time_Known_Value (Hi) @@ -11306,7 +11315,7 @@ package body Exp_Ch4 is S_Hiv : Ureal; begin - if Is_Real_Type (Operand_Type) then + if Is_Real_Type (Etype (Expr)) then S_Lov := Expr_Value_R (S_Lo); S_Hiv := Expr_Value_R (S_Hi); else @@ -11318,7 +11327,6 @@ package body Exp_Ch4 is and then S_Lov >= D_Lov and then S_Hiv <= D_Hiv then - Set_Do_Range_Check (Expression (N), False); return; end if; end; @@ -11327,18 +11335,21 @@ package body Exp_Ch4 is -- Otherwise rewrite the conversion as described above - Set_Do_Range_Check (Expression (N), False); + Conv := Convert_To (Btyp, Expr); - Conv := Relocate_Node (N); - Rewrite (Subtype_Mark (Conv), New_Occurrence_Of (Btyp, Loc)); - Set_Etype (Conv, Btyp); + -- If a conversion is necessary, then copy the specific flags from + -- the original one and also move the Do_Overflow_Check flag since + -- this new conversion is to the base type. - -- Enable overflow except for case of integer to float conversions, - -- where it is never required, since we can never have overflow in - -- this case. + if Nkind (Conv) = N_Type_Conversion then + Set_Conversion_OK (Conv, Conversion_OK (N)); + Set_Float_Truncate (Conv, Float_Truncate (N)); + Set_Rounded_Result (Conv, Rounded_Result (N)); - if not Is_Integer_Type (Operand_Type) then - Enable_Overflow_Check (Conv); + if Do_Overflow_Check (N) then + Set_Do_Overflow_Check (Conv); + Set_Do_Overflow_Check (N, False); + end if; end if; Tnn := Make_Temporary (Loc, 'T', Conv); @@ -11361,26 +11372,23 @@ package body Exp_Ch4 is -- in systems where Duration is larger than Long_Integer. if Is_Ordinary_Fixed_Point_Type (Target_Type) - and then Is_Floating_Point_Type (Operand_Type) - and then RM_Size (Base_Type (Target_Type)) <= - RM_Size (Standard_Long_Integer) + and then Is_Floating_Point_Type (Etype (Expr)) + and then RM_Size (Btyp) <= RM_Size (Standard_Long_Integer) and then Nkind (Lo) = N_Real_Literal and then Nkind (Hi) = N_Real_Literal then - -- Find the integer type of the right size to perform an unchecked - -- conversion to the target fixed-point type. - declare - Bfx_Type : constant Entity_Id := Base_Type (Target_Type); - Expr_Id : constant Entity_Id := - Make_Temporary (Loc, 'T', Conv); + Expr_Id : constant Entity_Id := Make_Temporary (Loc, 'T', Conv); Int_Type : Entity_Id; begin - if RM_Size (Bfx_Type) > RM_Size (Standard_Integer) then + -- Find an integer type of the appropriate size to perform an + -- unchecked conversion to the target fixed-point type. + + if RM_Size (Btyp) > RM_Size (Standard_Integer) then Int_Type := Standard_Long_Integer; - elsif RM_Size (Bfx_Type) > RM_Size (Standard_Short_Integer) then + elsif RM_Size (Btyp) > RM_Size (Standard_Short_Integer) then Int_Type := Standard_Integer; else @@ -11388,9 +11396,9 @@ package body Exp_Ch4 is end if; -- Generate a temporary with the integer value. Required in the - -- CCG compiler to ensure that runtime checks reference this + -- CCG compiler to ensure that run-time checks reference this -- integer expression (instead of the resulting fixed-point - -- value) because fixed-point values are handled by means of + -- value because fixed-point values are handled by means of -- unsigned integer types). Insert_Action (N, @@ -11443,7 +11451,8 @@ package body Exp_Ch4 is Attribute_Name => Name_Last); end if; - -- Build code for range checking + -- Build code for range checking. Note that checks are suppressed + -- here since we don't want a recursive range check popping up. Insert_Actions (N, New_List ( Make_Object_Declaration (Loc, @@ -11464,10 +11473,10 @@ package body Exp_Ch4 is Make_Op_Gt (Loc, Left_Opnd => Hi_Arg, Right_Opnd => Hi_Val)), - Reason => CE_Range_Check_Failed))); + Reason => CE_Range_Check_Failed)), + Suppress => All_Checks); - Rewrite (N, New_Occurrence_Of (Tnn, Loc)); - Analyze_And_Resolve (N, Btyp); + Rewrite (Expr, New_Occurrence_Of (Tnn, Loc)); end Real_Range_Check; ----------------------------- -- cgit v1.1 From 33defa7c6c36c0671b81b4785fbb250430a4a953 Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Mon, 12 Aug 2019 08:59:33 +0000 Subject: [Ada] Inconsistent compile time Constraint_Error warning This patch corrects several bugs within the compiler which led to inconsistent handling of compile time Constraint_Errors. Notibly, subtype out of range checks which are only out of range of the subtype must be warnings while out of range checks where the value is out of range of the base type must be an error. Also, type conversions and qualified expressions on literals constitute errors on any out of range value. The compiler needed many of these cases clarified. ------------ -- Source -- ------------ -- main.ads with System; package Main is type T_Enum is (Enum_1, Enum_2, Unknown) with Default_Value => Unknown; subtype T_Valid_Enum is T_Enum range Enum_1 .. Enum_2; Value : T_Valid_Enum; -- WARNING generic type T_Element is (<>); Init : T_Element; package Generic_Test is Value : T_Element := Init; end; package titi is new Generic_Test (T_Valid_Enum, Unknown); -- WARNING type My_Float is digits System.Max_Base_Digits; My_Float_Last : constant := My_Float'Last; Out_Of_Range : constant := My_Float_Last + 1.0; Flt1 : My_Float := Out_Of_Range; -- ERROR A : Positive := Positive (16#9999_9999_9999#); -- ERROR B : Positive := 16#9999_9999_9999#; -- ERROR C : Positive := 0; -- WARNING D : Positive := Positive (0); -- ERROR E : Positive := Positive'(16#9999_9999_9999#); -- ERROR F : Positive := Positive'(0); -- ERROR end; ----------------- -- Compilation -- ----------------- $ gnatmake -q -gnatw_a main.adb main.ads:9:12: warning: value not in range of type "T_Valid_Enum" defined at line 7 main.ads:9:12: warning: "Constraint_Error" will be raised at run time main.ads:18:52: warning: value not in range of type "T_Element" defined at line 12, instance at line 18 main.ads:18:52: warning: "Constraint_Error" will be raised at run time main.ads:25:23: value not in range of type "My_Float" defined at line 20 main.ads:25:23: static expression fails Constraint_Check main.ads:27:19: value not in range of type "Standard.Positive" main.ads:27:19: static expression fails Constraint_Check main.ads:28:19: value not in range of type "Standard.Positive" main.ads:28:19: static expression fails Constraint_Check main.ads:29:19: warning: value not in range of type "Standard.Positive" main.ads:29:19: warning: "Constraint_Error" will be raised at run time main.ads:30:19: value not in range of type "Standard.Positive" main.ads:30:19: static expression fails Constraint_Check main.ads:31:27: value not in range of type "Standard.Positive" main.ads:31:27: static expression fails Constraint_Check main.ads:32:27: value not in range of type "Standard.Positive" main.ads:32:27: static expression fails Constraint_Check gnatmake: "main.ads" compilation error 2019-08-12 Justin Squirek gcc/ada/ * sem_eval.adb (Check_Non_Static_Context): Add a condition to determine if a range violation constitues a warning or an error. (Out_Of_Range): Add a condition to determine if a range violation constitues a warning or an error. From-SVN: r274288 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/sem_eval.adb | 32 +++++++++++++++++++++++++------- 2 files changed, 32 insertions(+), 7 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d30e8e9..07166c6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-08-12 Justin Squirek + + * sem_eval.adb (Check_Non_Static_Context): Add a condition to + determine if a range violation constitues a warning or an error. + (Out_Of_Range): Add a condition to determine if a range + violation constitues a warning or an error. + 2019-08-12 Eric Botcazou * exp_ch4.adb (Real_Range_Check): Do not rewrite the conversion diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 734c961..e417a07 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -562,23 +562,31 @@ package body Sem_Eval is elsif Is_Out_Of_Range (N, Base_Type (T), Assume_Valid => True) then Out_Of_Range (N); - -- Give warning if outside subtype (where one or both of the bounds of - -- the subtype is static). This warning is omitted if the expression - -- appears in a range that could be null (warnings are handled elsewhere - -- for this case). + -- Give a warning or error on the value outside the subtype. A + -- warning is omitted if the expression appears in a range that could + -- be null (warnings are handled elsewhere for this case). elsif T /= Base_Type (T) and then Nkind (Parent (N)) /= N_Range then if Is_In_Range (N, T, Assume_Valid => True) then null; elsif Is_Out_Of_Range (N, T, Assume_Valid => True) then - -- Ignore out of range values for System.Priority in CodePeer -- mode since the actual target compiler may provide a wider -- range. if CodePeer_Mode and then T = RTE (RE_Priority) then Set_Do_Range_Check (N, False); + + -- Determine if the out of range violation constitutes a warning + -- or an error based on context according to RM 4.9 (34/3). + + elsif Nkind_In (Original_Node (N), N_Type_Conversion, + N_Qualified_Expression) + and then Comes_From_Source (Original_Node (N)) + then + Apply_Compile_Time_Constraint_Error + (N, "value not in range of}", CE_Range_Check_Failed); else Apply_Compile_Time_Constraint_Error (N, "value not in range of}<<", CE_Range_Check_Failed); @@ -5515,8 +5523,18 @@ package body Sem_Eval is -- CodePeer mode where the target runtime may have more priorities. elsif not CodePeer_Mode or else Etype (N) /= RTE (RE_Priority) then - Apply_Compile_Time_Constraint_Error - (N, "value not in range of}", CE_Range_Check_Failed); + -- Determine if the out of range violation constitutes a warning + -- or an error based on context according to RM 4.9 (34/3). + + if Nkind (Original_Node (N)) = N_Type_Conversion + and then not Comes_From_Source (Original_Node (N)) + then + Apply_Compile_Time_Constraint_Error + (N, "value not in range of}??", CE_Range_Check_Failed); + else + Apply_Compile_Time_Constraint_Error + (N, "value not in range of}", CE_Range_Check_Failed); + end if; end if; -- Here we generate a warning for the Ada 83 case, or when we are in an -- cgit v1.1 From 08c8696d4884425839fc5cd14a8788fe53f031e4 Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Mon, 12 Aug 2019 08:59:37 +0000 Subject: [Ada] SPARK: disable expansion of Enum_Rep Disable expansion of Enum_Rep into a type conversion as it is incorrect in SPARK. 2019-08-12 Yannick Moy gcc/ada/ * exp_spark.adb (Expand_SPARK_N_Attribute_Reference): Only expand Enum_Rep attribute when its parameter is a literal. From-SVN: r274289 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/exp_spark.adb | 26 +++++++++++++++++++++++++- 2 files changed, 30 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 07166c6..f6ce931 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-12 Yannick Moy + + * exp_spark.adb (Expand_SPARK_N_Attribute_Reference): Only + expand Enum_Rep attribute when its parameter is a literal. + 2019-08-12 Justin Squirek * sem_eval.adb (Check_Non_Static_Context): Add a condition to diff --git a/gcc/ada/exp_spark.adb b/gcc/ada/exp_spark.adb index 63f2dad..d6ed3d4 100644 --- a/gcc/ada/exp_spark.adb +++ b/gcc/ada/exp_spark.adb @@ -201,7 +201,31 @@ package body Exp_SPARK is -- by the corresponding literal value. elsif Attr_Id = Attribute_Enum_Rep then - Exp_Attr.Expand_N_Attribute_Reference (N); + declare + Exprs : constant List_Id := Expressions (N); + begin + if Is_Non_Empty_List (Exprs) then + Expr := First (Exprs); + else + Expr := Prefix (N); + end if; + + -- If the argument is a literal, expand it + + if Nkind (Expr) in N_Has_Entity + and then + (Ekind (Entity (Expr)) = E_Enumeration_Literal + or else + (Nkind (Expr) in N_Has_Entity + and then Ekind (Entity (Expr)) = E_Constant + and then Present (Renamed_Object (Entity (Expr))) + and then Is_Entity_Name (Renamed_Object (Entity (Expr))) + and then Ekind (Entity (Renamed_Object (Entity (Expr)))) = + E_Enumeration_Literal)) + then + Exp_Attr.Expand_N_Attribute_Reference (N); + end if; + end; -- For attributes which return Universal_Integer, introduce a conversion -- to the expected type with the appropriate check flags set. -- cgit v1.1 From d39f6b24d401c8a945fae1488de0dea2252ec7ae Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Mon, 12 Aug 2019 08:59:42 +0000 Subject: [Ada] More precise handling of Size/Object_Size in GNATprove GNATprove does a partial expansion which did not allow getting the most precise value for attributes Size/Object_Size. Now fixed. There is no impact on compilation. 2019-08-12 Yannick Moy gcc/ada/ * exp_attr.adb, exp_attr.ads (Expand_Size_Attribute): New procedure to share part of the attribute expansion with GNATprove mode. (Expand_N_Attribute_Reference): Extract part of the Size/Object_Size expansion in the new procedure Expand_Size_Attribute. * exp_spark.adb (Expand_SPARK_N_Attribute_Reference): Expand Size/Object_Size attributes using the new procedure Expand_Size_Attribute. From-SVN: r274290 --- gcc/ada/ChangeLog | 12 +++ gcc/ada/exp_attr.adb | 261 +++++++++++++++++++++++++++----------------------- gcc/ada/exp_attr.ads | 5 + gcc/ada/exp_spark.adb | 11 ++- 4 files changed, 163 insertions(+), 126 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f6ce931..ca2030d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,17 @@ 2019-08-12 Yannick Moy + * exp_attr.adb, exp_attr.ads (Expand_Size_Attribute): New + procedure to share part of the attribute expansion with + GNATprove mode. + (Expand_N_Attribute_Reference): Extract part of the + Size/Object_Size expansion in the new procedure + Expand_Size_Attribute. + * exp_spark.adb (Expand_SPARK_N_Attribute_Reference): Expand + Size/Object_Size attributes using the new procedure + Expand_Size_Attribute. + +2019-08-12 Yannick Moy + * exp_spark.adb (Expand_SPARK_N_Attribute_Reference): Only expand Enum_Rep attribute when its parameter is a literal. diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 9d6da33..d90dc29 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -3598,8 +3598,8 @@ package body Exp_Attr is -- Result_Type (System.Fore (Universal_Real (Type'First)), -- Universal_Real (Type'Last)) - -- Note that we know that the type is a non-static subtype, or Fore - -- would have itself been computed dynamically in Eval_Attribute. + -- Note that we know that the type is a nonstatic subtype, or Fore would + -- have itself been computed dynamically in Eval_Attribute. when Attribute_Fore => Rewrite (N, @@ -5849,7 +5849,6 @@ package body Exp_Attr is | Attribute_VADS_Size => Size : declare - Siz : Uint; New_Node : Node_Id; begin @@ -5961,128 +5960,12 @@ package body Exp_Attr is Rewrite (N, New_Node); Analyze_And_Resolve (N, Typ); return; - - -- Case of known RM_Size of a type - - elsif (Id = Attribute_Size or else Id = Attribute_Value_Size) - and then Is_Entity_Name (Pref) - and then Is_Type (Entity (Pref)) - and then Known_Static_RM_Size (Entity (Pref)) - then - Siz := RM_Size (Entity (Pref)); - - -- Case of known Esize of a type - - elsif Id = Attribute_Object_Size - and then Is_Entity_Name (Pref) - and then Is_Type (Entity (Pref)) - and then Known_Static_Esize (Entity (Pref)) - then - Siz := Esize (Entity (Pref)); - - -- Case of known size of object - - elsif Id = Attribute_Size - and then Is_Entity_Name (Pref) - and then Is_Object (Entity (Pref)) - and then Known_Esize (Entity (Pref)) - and then Known_Static_Esize (Entity (Pref)) - then - Siz := Esize (Entity (Pref)); - - -- For an array component, we can do Size in the front end if the - -- component_size of the array is set. - - elsif Nkind (Pref) = N_Indexed_Component then - Siz := Component_Size (Etype (Prefix (Pref))); - - -- For a record component, we can do Size in the front end if - -- there is a component clause, or if the record is packed and the - -- component's size is known at compile time. - - elsif Nkind (Pref) = N_Selected_Component then - declare - Rec : constant Entity_Id := Etype (Prefix (Pref)); - Comp : constant Entity_Id := Entity (Selector_Name (Pref)); - - begin - if Present (Component_Clause (Comp)) then - Siz := Esize (Comp); - - elsif Is_Packed (Rec) then - Siz := RM_Size (Ptyp); - - else - Apply_Universal_Integer_Attribute_Checks (N); - return; - end if; - end; - - -- All other cases are handled by the back end - - else - Apply_Universal_Integer_Attribute_Checks (N); - - -- If Size is applied to a formal parameter that is of a packed - -- array subtype, then apply Size to the actual subtype. - - if Is_Entity_Name (Pref) - and then Is_Formal (Entity (Pref)) - and then Is_Array_Type (Ptyp) - and then Is_Packed (Ptyp) - then - Rewrite (N, - Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Get_Actual_Subtype (Pref), Loc), - Attribute_Name => Name_Size)); - Analyze_And_Resolve (N, Typ); - end if; - - -- If Size applies to a dereference of an access to - -- unconstrained packed array, the back end needs to see its - -- unconstrained nominal type, but also a hint to the actual - -- constrained type. - - if Nkind (Pref) = N_Explicit_Dereference - and then Is_Array_Type (Ptyp) - and then not Is_Constrained (Ptyp) - and then Is_Packed (Ptyp) - then - Set_Actual_Designated_Subtype (Pref, - Get_Actual_Subtype (Pref)); - end if; - - return; end if; - -- Common processing for record and array component case + -- Call Expand_Size_Attribute to do the final part of the + -- expansion which is shared with GNATprove expansion. - if Siz /= No_Uint and then Siz /= 0 then - declare - CS : constant Boolean := Comes_From_Source (N); - - begin - Rewrite (N, Make_Integer_Literal (Loc, Siz)); - - -- This integer literal is not a static expression. We do - -- not call Analyze_And_Resolve here, because this would - -- activate the circuit for deciding that a static value - -- was out of range, and we don't want that. - - -- So just manually set the type, mark the expression as - -- non-static, and then ensure that the result is checked - -- properly if the attribute comes from source (if it was - -- internally generated, we never need a constraint check). - - Set_Etype (N, Typ); - Set_Is_Static_Expression (N, False); - - if CS then - Apply_Constraint_Check (N, Typ); - end if; - end; - end if; + Expand_Size_Attribute (N); end Size; ------------------ @@ -7608,6 +7491,140 @@ package body Exp_Attr is end if; end Expand_Pred_Succ_Attribute; + --------------------------- + -- Expand_Size_Attribute -- + --------------------------- + + procedure Expand_Size_Attribute (N : Node_Id) is + Loc : constant Source_Ptr := Sloc (N); + Typ : constant Entity_Id := Etype (N); + Pref : constant Node_Id := Prefix (N); + Ptyp : constant Entity_Id := Etype (Pref); + Id : constant Attribute_Id := Get_Attribute_Id (Attribute_Name (N)); + Siz : Uint; + + begin + -- Case of known RM_Size of a type + + if (Id = Attribute_Size or else Id = Attribute_Value_Size) + and then Is_Entity_Name (Pref) + and then Is_Type (Entity (Pref)) + and then Known_Static_RM_Size (Entity (Pref)) + then + Siz := RM_Size (Entity (Pref)); + + -- Case of known Esize of a type + + elsif Id = Attribute_Object_Size + and then Is_Entity_Name (Pref) + and then Is_Type (Entity (Pref)) + and then Known_Static_Esize (Entity (Pref)) + then + Siz := Esize (Entity (Pref)); + + -- Case of known size of object + + elsif Id = Attribute_Size + and then Is_Entity_Name (Pref) + and then Is_Object (Entity (Pref)) + and then Known_Esize (Entity (Pref)) + and then Known_Static_Esize (Entity (Pref)) + then + Siz := Esize (Entity (Pref)); + + -- For an array component, we can do Size in the front end if the + -- component_size of the array is set. + + elsif Nkind (Pref) = N_Indexed_Component then + Siz := Component_Size (Etype (Prefix (Pref))); + + -- For a record component, we can do Size in the front end if there is a + -- component clause, or if the record is packed and the component's size + -- is known at compile time. + + elsif Nkind (Pref) = N_Selected_Component then + declare + Rec : constant Entity_Id := Etype (Prefix (Pref)); + Comp : constant Entity_Id := Entity (Selector_Name (Pref)); + + begin + if Present (Component_Clause (Comp)) then + Siz := Esize (Comp); + + elsif Is_Packed (Rec) then + Siz := RM_Size (Ptyp); + + else + Apply_Universal_Integer_Attribute_Checks (N); + return; + end if; + end; + + -- All other cases are handled by the back end + + else + Apply_Universal_Integer_Attribute_Checks (N); + + -- If Size is applied to a formal parameter that is of a packed + -- array subtype, then apply Size to the actual subtype. + + if Is_Entity_Name (Pref) + and then Is_Formal (Entity (Pref)) + and then Is_Array_Type (Ptyp) + and then Is_Packed (Ptyp) + then + Rewrite (N, + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of (Get_Actual_Subtype (Pref), Loc), + Attribute_Name => Name_Size)); + Analyze_And_Resolve (N, Typ); + end if; + + -- If Size applies to a dereference of an access to unconstrained + -- packed array, the back end needs to see its unconstrained nominal + -- type, but also a hint to the actual constrained type. + + if Nkind (Pref) = N_Explicit_Dereference + and then Is_Array_Type (Ptyp) + and then not Is_Constrained (Ptyp) + and then Is_Packed (Ptyp) + then + Set_Actual_Designated_Subtype (Pref, Get_Actual_Subtype (Pref)); + end if; + + return; + end if; + + -- Common processing for record and array component case + + if Siz /= No_Uint and then Siz /= 0 then + declare + CS : constant Boolean := Comes_From_Source (N); + + begin + Rewrite (N, Make_Integer_Literal (Loc, Siz)); + + -- This integer literal is not a static expression. We do not + -- call Analyze_And_Resolve here, because this would activate + -- the circuit for deciding that a static value was out of range, + -- and we don't want that. + + -- So just manually set the type, mark the expression as + -- nonstatic, and then ensure that the result is checked + -- properly if the attribute comes from source (if it was + -- internally generated, we never need a constraint check). + + Set_Etype (N, Typ); + Set_Is_Static_Expression (N, False); + + if CS then + Apply_Constraint_Check (N, Typ); + end if; + end; + end if; + end Expand_Size_Attribute; + ----------------------------- -- Expand_Update_Attribute -- ----------------------------- diff --git a/gcc/ada/exp_attr.ads b/gcc/ada/exp_attr.ads index 5a3fefc..8ca9b10 100644 --- a/gcc/ada/exp_attr.ads +++ b/gcc/ada/exp_attr.ads @@ -31,4 +31,9 @@ package Exp_Attr is procedure Expand_N_Attribute_Reference (N : Node_Id); + procedure Expand_Size_Attribute (N : Node_Id); + -- Handles part of the expansion of attributes 'Object_Size, 'Size, + -- 'Value_Size, and 'VADS_Size, so that it can also be used in the special + -- expansion in GNATprove mode. + end Exp_Attr; diff --git a/gcc/ada/exp_spark.adb b/gcc/ada/exp_spark.adb index d6ed3d4..ea1381c 100644 --- a/gcc/ada/exp_spark.adb +++ b/gcc/ada/exp_spark.adb @@ -227,6 +227,13 @@ package body Exp_SPARK is end if; end; + elsif Attr_Id = Attribute_Object_Size + or else Attr_Id = Attribute_Size + or else Attr_Id = Attribute_Value_Size + or else Attr_Id = Attribute_VADS_Size + then + Exp_Attr.Expand_Size_Attribute (N); + -- For attributes which return Universal_Integer, introduce a conversion -- to the expected type with the appropriate check flags set. @@ -241,10 +248,6 @@ package body Exp_SPARK is or else Attr_Id = Attribute_Pos or else Attr_Id = Attribute_Position or else Attr_Id = Attribute_Range_Length - or else Attr_Id = Attribute_Object_Size - or else Attr_Id = Attribute_Size - or else Attr_Id = Attribute_Value_Size - or else Attr_Id = Attribute_VADS_Size or else Attr_Id = Attribute_Aft or else Attr_Id = Attribute_Max_Alignment_For_Allocation then -- cgit v1.1 From 1debd630ed40eec6db2f4aab4524fde4643b70a7 Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Mon, 12 Aug 2019 08:59:47 +0000 Subject: [Ada] Adapt new extended traversal of AST to have optional part The new extended traversal of the AST for GNATprove use now optionally traverses the ranges under Itypes, based on a formal parameter. There is no impact on compilation. 2019-08-12 Yannick Moy gcc/ada/ * sem_util.adb, sem_util.ads (Traverse_More_Func, Traverse_More_Proc): Add formal parameter for Itypes traversal. From-SVN: r274291 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem_util.adb | 12 +++++++----- gcc/ada/sem_util.ads | 3 +++ 3 files changed, 15 insertions(+), 5 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ca2030d..5e8fd9e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2019-08-12 Yannick Moy + * sem_util.adb, sem_util.ads (Traverse_More_Func, + Traverse_More_Proc): Add formal parameter for Itypes traversal. + +2019-08-12 Yannick Moy + * exp_attr.adb, exp_attr.ads (Expand_Size_Attribute): New procedure to share part of the attribute expansion with GNATprove mode. diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index acc257c..b56fa86 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -25565,11 +25565,13 @@ package body Sem_Util is null; end case; - -- Then process unattached nodes which come from Itypes. This only - -- concerns currently ranges of scalar (possibly as index) types. - -- This traversal is protected against looping with Processing_Itype. + -- If Process_Itypes is True, process unattached nodes which come + -- from Itypes. This only concerns currently ranges of scalar + -- (possibly as index) types. This traversal is protected against + -- looping with Processing_Itype. - if not Processing_Itype + if Process_Itypes + and then not Processing_Itype and then Nkind (Node) in N_Has_Etype and then Present (Etype (Node)) and then Is_Itype (Etype (Node)) @@ -25628,7 +25630,7 @@ package body Sem_Util is ------------------------ procedure Traverse_More_Proc (Node : Node_Id) is - function Traverse is new Traverse_More_Func (Process); + function Traverse is new Traverse_More_Func (Process, Process_Itypes); Discard : Traverse_Final_Result; pragma Warnings (Off, Discard); begin diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 478f570..2c1f8a8 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -2814,14 +2814,17 @@ package Sem_Util is generic with function Process (N : Node_Id) return Traverse_Result is <>; + Process_Itypes : Boolean := False; function Traverse_More_Func (Node : Node_Id) return Traverse_Final_Result; -- This is a version of Atree.Traverse_Func that not only traverses -- syntactic children of nodes, but also semantic children which are -- logically children of the node. This concerns currently lists of -- action nodes and ranges under Itypes, both inserted by the compiler. + -- Itypes are only traversed when Process_Itypes is True. generic with function Process (N : Node_Id) return Traverse_Result is <>; + Process_Itypes : Boolean := False; procedure Traverse_More_Proc (Node : Node_Id); pragma Inline (Traverse_More_Proc); -- This is the same as Traverse_More_Func except that no result is -- cgit v1.1 From 9dfc6c55085848a60d19825bdc0b7d345bdf8603 Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Mon, 12 Aug 2019 08:59:53 +0000 Subject: [Ada] New aspect/pragma No_Caching for analysis of volatile data A new aspect/pragma can be attached to volatile variables to indicate that such a variable is not used for interactions with the external world, but only that accesses to that variable should not be optimized by the compiler. This is in particular useful for guarding against fault injection. SPARK Reference manual has been updated to allow this use of volatile data, see section 7.1.2, so that GNATprove can analyze such variables as not volatile. 2019-08-12 Yannick Moy gcc/ada/ * aspects.adb, aspects.ads (Aspect_No_Caching): New aspect. * contracts.adb, contracts.ads (Add_Contract_Item): Add handling of No_Caching. (Analyze_Object_Contract): Add handling of No_Caching. * einfo.adb, einfo.ads (Get_Pragma): Add handling of No_Caching. * doc/gnat_rm/implementation_defined_aspects.rst, doc/gnat_rm/implementation_defined_pragmas.rst: Document new aspect/pragma. * gnat_rm.texi: Regenerate. * par-prag.adb (Prag): New pragma Pragma_No_Caching. * sem_ch13.adb (Analyze_Aspect_Specifications, Check_Aspect_At_Freeze_Point): Add handling of No_Caching. * sem_prag.adb (Analyze_Pragma): Deal with pragma No_Caching. * sem_prag.ads (Analyze_External_Property_In_Decl_Part): Now applies to No_Caching. * sem_util.adb, sem_util.ads (Is_Effectively_Volatile): Add handling of No_Caching. (No_Caching_Enabled): New query function. * snames.ads-tmpl: New names for pragma. gcc/testsuite/ * gnat.dg/no_caching.adb, gnat.dg/no_caching.ads: New testcase. From-SVN: r274292 --- gcc/ada/ChangeLog | 23 + gcc/ada/aspects.adb | 1 + gcc/ada/aspects.ads | 4 + gcc/ada/contracts.adb | 11 + gcc/ada/contracts.ads | 1 + .../doc/gnat_rm/implementation_defined_aspects.rst | 6 + .../doc/gnat_rm/implementation_defined_pragmas.rst | 15 + gcc/ada/einfo.adb | 1 + gcc/ada/einfo.ads | 1 + gcc/ada/gnat_rm.texi | 1435 ++++++++++---------- gcc/ada/par-prag.adb | 1 + gcc/ada/sem_ch13.adb | 18 +- gcc/ada/sem_prag.adb | 32 +- gcc/ada/sem_prag.ads | 5 +- gcc/ada/sem_util.adb | 37 +- gcc/ada/sem_util.ads | 7 +- gcc/ada/snames.ads-tmpl | 2 + 17 files changed, 887 insertions(+), 713 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5e8fd9e..78d78cc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,28 @@ 2019-08-12 Yannick Moy + * aspects.adb, aspects.ads (Aspect_No_Caching): New aspect. + * contracts.adb, contracts.ads (Add_Contract_Item): Add handling + of No_Caching. + (Analyze_Object_Contract): Add handling of No_Caching. + * einfo.adb, einfo.ads + (Get_Pragma): Add handling of No_Caching. + * doc/gnat_rm/implementation_defined_aspects.rst, + doc/gnat_rm/implementation_defined_pragmas.rst: Document new + aspect/pragma. + * gnat_rm.texi: Regenerate. + * par-prag.adb (Prag): New pragma Pragma_No_Caching. + * sem_ch13.adb (Analyze_Aspect_Specifications, + Check_Aspect_At_Freeze_Point): Add handling of No_Caching. + * sem_prag.adb (Analyze_Pragma): Deal with pragma No_Caching. + * sem_prag.ads (Analyze_External_Property_In_Decl_Part): Now + applies to No_Caching. + * sem_util.adb, sem_util.ads (Is_Effectively_Volatile): Add + handling of No_Caching. + (No_Caching_Enabled): New query function. + * snames.ads-tmpl: New names for pragma. + +2019-08-12 Yannick Moy + * sem_util.adb, sem_util.ads (Traverse_More_Func, Traverse_More_Proc): Add formal parameter for Itypes traversal. diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index 54c0e56..4618749d 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -573,6 +573,7 @@ package body Aspects is Aspect_Machine_Radix => Aspect_Machine_Radix, Aspect_Max_Entry_Queue_Depth => Aspect_Max_Entry_Queue_Depth, Aspect_Max_Queue_Length => Aspect_Max_Queue_Length, + Aspect_No_Caching => Aspect_No_Caching, Aspect_No_Elaboration_Code_All => Aspect_No_Elaboration_Code_All, Aspect_No_Inline => Aspect_No_Inline, Aspect_No_Return => Aspect_No_Return, diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 2a6acc2..86eb722 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -118,6 +118,7 @@ package Aspects is Aspect_Machine_Radix, Aspect_Max_Entry_Queue_Depth, Aspect_Max_Queue_Length, -- GNAT + Aspect_No_Caching, -- GNAT Aspect_Object_Size, -- GNAT Aspect_Obsolescent, -- GNAT Aspect_Output, @@ -376,6 +377,7 @@ package Aspects is Aspect_Machine_Radix => Expression, Aspect_Max_Entry_Queue_Depth => Expression, Aspect_Max_Queue_Length => Expression, + Aspect_No_Caching => Optional_Expression, Aspect_Object_Size => Expression, Aspect_Obsolescent => Optional_Expression, Aspect_Output => Name, @@ -486,6 +488,7 @@ package Aspects is Aspect_Machine_Radix => Name_Machine_Radix, Aspect_Max_Entry_Queue_Depth => Name_Max_Entry_Queue_Depth, Aspect_Max_Queue_Length => Name_Max_Queue_Length, + Aspect_No_Caching => Name_No_Caching, Aspect_No_Elaboration_Code_All => Name_No_Elaboration_Code_All, Aspect_No_Inline => Name_No_Inline, Aspect_No_Return => Name_No_Return, @@ -763,6 +766,7 @@ package Aspects is Aspect_Initializes => Never_Delay, Aspect_Max_Entry_Queue_Depth => Never_Delay, Aspect_Max_Queue_Length => Never_Delay, + Aspect_No_Caching => Never_Delay, Aspect_No_Elaboration_Code_All => Never_Delay, Aspect_No_Tagged_Streams => Never_Delay, Aspect_Obsolescent => Never_Delay, diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index 4610b53..981bb91 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -317,6 +317,7 @@ package body Contracts is -- Effective_Reads -- Effective_Writes -- Global + -- No_Caching -- Part_Of elsif Ekind (Id) = E_Variable then @@ -327,6 +328,7 @@ package body Contracts is Name_Effective_Reads, Name_Effective_Writes, Name_Global, + Name_No_Caching, Name_Part_Of) then Add_Classification; @@ -741,6 +743,7 @@ package body Contracts is AW_Val : Boolean := False; ER_Val : Boolean := False; EW_Val : Boolean := False; + NC_Val : Boolean := False; Items : Node_Id; Prag : Node_Id; Ref_Elmt : Elmt_Id; @@ -847,6 +850,14 @@ package body Contracts is Check_External_Properties (Obj_Id, AR_Val, AW_Val, ER_Val, EW_Val); end if; + -- Analyze the non-external volatility property No_Caching + + Prag := Get_Pragma (Obj_Id, Pragma_No_Caching); + + if Present (Prag) then + Analyze_External_Property_In_Decl_Part (Prag, NC_Val); + end if; + -- The anonymous object created for a single concurrent type carries -- pragmas Depends and Globat of the type. diff --git a/gcc/ada/contracts.ads b/gcc/ada/contracts.ads index 0dc5ff9..ca99c34 100644 --- a/gcc/ada/contracts.ads +++ b/gcc/ada/contracts.ads @@ -50,6 +50,7 @@ package Contracts is -- Initial_Condition -- Initializes -- Interrupt_Handler + -- No_Caching -- Part_Of -- Postcondition -- Precondition diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst b/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst index 0fa4476..89f6718 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst @@ -370,6 +370,12 @@ Aspect Max_Queue_Length This aspect is equivalent to :ref:`pragma Max_Queue_Length`. +Aspect No_Caching +================= +.. index:: No_Caching + +This boolean aspect is equivalent to :ref:`pragma No_Caching`. + Aspect No_Elaboration_Code_All ============================== .. index:: No_Elaboration_Code_All diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst index 04b0def..a4ff222 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst @@ -3881,6 +3881,20 @@ such a way that a body needed before is no longer needed. The provision of a dummy body with a No_Body pragma ensures that there is no interference from earlier versions of the package body. +.. _Pragma-No_Caching: + +Pragma No_Caching +================= + +Syntax: + +.. code-block:: ada + + pragma No_Caching [ (boolean_EXPRESSION) ]; + +For the semantics of this pragma, see the entry for aspect ``No_Caching`` in +the SPARK 2014 Reference Manual, section 7.1.2. + Pragma No_Component_Reordering ============================== @@ -7355,6 +7369,7 @@ validity checks as shown in the following example: pragma Validity_Checks (On); -- turn validity checks back on A := C; -- C will be validity checked +.. _Pragma-Volatile: Pragma Volatile =============== diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 8ff9ec6..4e5681d 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -7589,6 +7589,7 @@ package body Einfo is Id = Pragma_Initial_Condition or else Id = Pragma_Initializes or else Id = Pragma_Interrupt_Handler or else + Id = Pragma_No_Caching or else Id = Pragma_Part_Of or else Id = Pragma_Refined_Depends or else Id = Pragma_Refined_Global or else diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 78208a1..007b7d2 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -8429,6 +8429,7 @@ package Einfo is -- Initial_Condition -- Initializes -- Interrupt_Handler + -- No_Caching -- Part_Of -- Precondition -- Postcondition diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 257c394..7de5de6 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -21,7 +21,7 @@ @copying @quotation -GNAT Reference Manual , Jun 21, 2019 +GNAT Reference Manual , Jul 31, 2019 AdaCore @@ -207,6 +207,7 @@ Implementation Defined Pragmas * Pragma Main_Storage:: * Pragma Max_Queue_Length:: * Pragma No_Body:: +* Pragma No_Caching:: * Pragma No_Component_Reordering:: * Pragma No_Elaboration_Code_All:: * Pragma No_Heap_Finalization:: @@ -331,6 +332,7 @@ Implementation Defined Aspects * Aspect Linker_Section:: * Aspect Lock_Free:: * Aspect Max_Queue_Length:: +* Aspect No_Caching:: * Aspect No_Elaboration_Code_All:: * Aspect No_Inline:: * Aspect No_Tagged_Streams:: @@ -1282,6 +1284,7 @@ consideration, the use of these pragmas should be minimized. * Pragma Main_Storage:: * Pragma Max_Queue_Length:: * Pragma No_Body:: +* Pragma No_Caching:: * Pragma No_Component_Reordering:: * Pragma No_Elaboration_Code_All:: * Pragma No_Heap_Finalization:: @@ -5335,7 +5338,7 @@ individual protected entries and entry families. It accepts a single positive integer as a parameter and must appear after the declaration of an entry. -@node Pragma No_Body,Pragma No_Component_Reordering,Pragma Max_Queue_Length,Implementation Defined Pragmas +@node Pragma No_Body,Pragma No_Caching,Pragma Max_Queue_Length,Implementation Defined Pragmas @anchor{gnat_rm/implementation_defined_pragmas pragma-no-body}@anchor{a0} @section Pragma No_Body @@ -5358,8 +5361,22 @@ such a way that a body needed before is no longer needed. The provision of a dummy body with a No_Body pragma ensures that there is no interference from earlier versions of the package body. -@node Pragma No_Component_Reordering,Pragma No_Elaboration_Code_All,Pragma No_Body,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-no-component-reordering}@anchor{a1} +@node Pragma No_Caching,Pragma No_Component_Reordering,Pragma No_Body,Implementation Defined Pragmas +@anchor{gnat_rm/implementation_defined_pragmas pragma-no-caching}@anchor{a1}@anchor{gnat_rm/implementation_defined_pragmas id23}@anchor{a2} +@section Pragma No_Caching + + +Syntax: + +@example +pragma No_Caching [ (boolean_EXPRESSION) ]; +@end example + +For the semantics of this pragma, see the entry for aspect @code{No_Caching} in +the SPARK 2014 Reference Manual, section 7.1.2. + +@node Pragma No_Component_Reordering,Pragma No_Elaboration_Code_All,Pragma No_Caching,Implementation Defined Pragmas +@anchor{gnat_rm/implementation_defined_pragmas pragma-no-component-reordering}@anchor{a3} @section Pragma No_Component_Reordering @@ -5378,7 +5395,7 @@ declared in units to which the pragma applies and there is a requirement that this pragma be used consistently within a partition. @node Pragma No_Elaboration_Code_All,Pragma No_Heap_Finalization,Pragma No_Component_Reordering,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas id23}@anchor{a2}@anchor{gnat_rm/implementation_defined_pragmas pragma-no-elaboration-code-all}@anchor{a3} +@anchor{gnat_rm/implementation_defined_pragmas id24}@anchor{a4}@anchor{gnat_rm/implementation_defined_pragmas pragma-no-elaboration-code-all}@anchor{a5} @section Pragma No_Elaboration_Code_All @@ -5397,7 +5414,7 @@ current unit, it must also have the No_Elaboration_Code_All aspect set. It may be applied to package or subprogram specs or their generic versions. @node Pragma No_Heap_Finalization,Pragma No_Inline,Pragma No_Elaboration_Code_All,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-no-heap-finalization}@anchor{a4} +@anchor{gnat_rm/implementation_defined_pragmas pragma-no-heap-finalization}@anchor{a6} @section Pragma No_Heap_Finalization @@ -5429,7 +5446,7 @@ lose its @code{No_Heap_Finalization} pragma when the corresponding instance does appear at the library level. @node Pragma No_Inline,Pragma No_Return,Pragma No_Heap_Finalization,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas id24}@anchor{a5}@anchor{gnat_rm/implementation_defined_pragmas pragma-no-inline}@anchor{a6} +@anchor{gnat_rm/implementation_defined_pragmas id25}@anchor{a7}@anchor{gnat_rm/implementation_defined_pragmas pragma-no-inline}@anchor{a8} @section Pragma No_Inline @@ -5447,7 +5464,7 @@ in particular it is not subject to the use of option @emph{-gnatn} or pragma @code{Inline_Always} for the same @code{NAME}. @node Pragma No_Return,Pragma No_Run_Time,Pragma No_Inline,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-no-return}@anchor{a7} +@anchor{gnat_rm/implementation_defined_pragmas pragma-no-return}@anchor{a9} @section Pragma No_Return @@ -5474,7 +5491,7 @@ available in all earlier versions of Ada as an implementation-defined pragma. @node Pragma No_Run_Time,Pragma No_Strict_Aliasing,Pragma No_Return,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-no-run-time}@anchor{a8} +@anchor{gnat_rm/implementation_defined_pragmas pragma-no-run-time}@anchor{aa} @section Pragma No_Run_Time @@ -5490,7 +5507,7 @@ internal testing. The pragma has been superseded by the reconfigurable runtime capability of GNAT. @node Pragma No_Strict_Aliasing,Pragma No_Tagged_Streams,Pragma No_Run_Time,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-no-strict-aliasing}@anchor{a9} +@anchor{gnat_rm/implementation_defined_pragmas pragma-no-strict-aliasing}@anchor{ab} @section Pragma No_Strict_Aliasing @@ -5512,7 +5529,7 @@ in the @cite{GNAT User's Guide}. This pragma currently has no effects on access to unconstrained array types. @node Pragma No_Tagged_Streams,Pragma Normalize_Scalars,Pragma No_Strict_Aliasing,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-no-tagged-streams}@anchor{aa}@anchor{gnat_rm/implementation_defined_pragmas id25}@anchor{ab} +@anchor{gnat_rm/implementation_defined_pragmas pragma-no-tagged-streams}@anchor{ac}@anchor{gnat_rm/implementation_defined_pragmas id26}@anchor{ad} @section Pragma No_Tagged_Streams @@ -5551,7 +5568,7 @@ with empty strings. This is useful to avoid exposing entity names at binary level but has a negative impact on the debuggability of tagged types. @node Pragma Normalize_Scalars,Pragma Obsolescent,Pragma No_Tagged_Streams,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-normalize-scalars}@anchor{ac} +@anchor{gnat_rm/implementation_defined_pragmas pragma-normalize-scalars}@anchor{ae} @section Pragma Normalize_Scalars @@ -5633,7 +5650,7 @@ will always generate an invalid value if one exists. @end table @node Pragma Obsolescent,Pragma Optimize_Alignment,Pragma Normalize_Scalars,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-obsolescent}@anchor{ad}@anchor{gnat_rm/implementation_defined_pragmas id26}@anchor{ae} +@anchor{gnat_rm/implementation_defined_pragmas pragma-obsolescent}@anchor{af}@anchor{gnat_rm/implementation_defined_pragmas id27}@anchor{b0} @section Pragma Obsolescent @@ -5729,7 +5746,7 @@ So if you specify @code{Entity =>} for the @code{Entity} argument, and a @code{M argument is present, it must be preceded by @code{Message =>}. @node Pragma Optimize_Alignment,Pragma Ordered,Pragma Obsolescent,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-optimize-alignment}@anchor{af} +@anchor{gnat_rm/implementation_defined_pragmas pragma-optimize-alignment}@anchor{b1} @section Pragma Optimize_Alignment @@ -5815,7 +5832,7 @@ latter are compiled by default in pragma Optimize_Alignment (Off) mode if no pragma appears at the start of the file. @node Pragma Ordered,Pragma Overflow_Mode,Pragma Optimize_Alignment,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-ordered}@anchor{b0} +@anchor{gnat_rm/implementation_defined_pragmas pragma-ordered}@anchor{b2} @section Pragma Ordered @@ -5907,7 +5924,7 @@ For additional information please refer to the description of the @emph{-gnatw.u} switch in the GNAT User's Guide. @node Pragma Overflow_Mode,Pragma Overriding_Renamings,Pragma Ordered,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-overflow-mode}@anchor{b1} +@anchor{gnat_rm/implementation_defined_pragmas pragma-overflow-mode}@anchor{b3} @section Pragma Overflow_Mode @@ -5946,7 +5963,7 @@ The pragma @code{Unsuppress (Overflow_Check)} unsuppresses (enables) overflow checking, but does not affect the overflow mode. @node Pragma Overriding_Renamings,Pragma Partition_Elaboration_Policy,Pragma Overflow_Mode,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-overriding-renamings}@anchor{b2} +@anchor{gnat_rm/implementation_defined_pragmas pragma-overriding-renamings}@anchor{b4} @section Pragma Overriding_Renamings @@ -5981,7 +5998,7 @@ RM 8.3 (15) stipulates that an overridden operation is not visible within the declaration of the overriding operation. @node Pragma Partition_Elaboration_Policy,Pragma Part_Of,Pragma Overriding_Renamings,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-partition-elaboration-policy}@anchor{b3} +@anchor{gnat_rm/implementation_defined_pragmas pragma-partition-elaboration-policy}@anchor{b5} @section Pragma Partition_Elaboration_Policy @@ -5998,7 +6015,7 @@ versions of Ada as an implementation-defined pragma. See Ada 2012 Reference Manual for details. @node Pragma Part_Of,Pragma Passive,Pragma Partition_Elaboration_Policy,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas id27}@anchor{b4}@anchor{gnat_rm/implementation_defined_pragmas pragma-part-of}@anchor{b5} +@anchor{gnat_rm/implementation_defined_pragmas id28}@anchor{b6}@anchor{gnat_rm/implementation_defined_pragmas pragma-part-of}@anchor{b7} @section Pragma Part_Of @@ -6014,7 +6031,7 @@ For the semantics of this pragma, see the entry for aspect @code{Part_Of} in the SPARK 2014 Reference Manual, section 7.2.6. @node Pragma Passive,Pragma Persistent_BSS,Pragma Part_Of,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-passive}@anchor{b6} +@anchor{gnat_rm/implementation_defined_pragmas pragma-passive}@anchor{b8} @section Pragma Passive @@ -6038,7 +6055,7 @@ For more information on the subject of passive tasks, see the section 'Passive Task Optimization' in the GNAT Users Guide. @node Pragma Persistent_BSS,Pragma Polling,Pragma Passive,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas id28}@anchor{b7}@anchor{gnat_rm/implementation_defined_pragmas pragma-persistent-bss}@anchor{b8} +@anchor{gnat_rm/implementation_defined_pragmas id29}@anchor{b9}@anchor{gnat_rm/implementation_defined_pragmas pragma-persistent-bss}@anchor{ba} @section Pragma Persistent_BSS @@ -6069,7 +6086,7 @@ If this pragma is used on a target where this feature is not supported, then the pragma will be ignored. See also @code{pragma Linker_Section}. @node Pragma Polling,Pragma Post,Pragma Persistent_BSS,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-polling}@anchor{b9} +@anchor{gnat_rm/implementation_defined_pragmas pragma-polling}@anchor{bb} @section Pragma Polling @@ -6111,7 +6128,7 @@ Note that polling can also be enabled by use of the @emph{-gnatP} switch. See the section on switches for gcc in the @cite{GNAT User's Guide}. @node Pragma Post,Pragma Postcondition,Pragma Polling,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-post}@anchor{ba} +@anchor{gnat_rm/implementation_defined_pragmas pragma-post}@anchor{bc} @section Pragma Post @@ -6136,7 +6153,7 @@ appear at the start of the declarations in a subprogram body (preceded only by other pragmas). @node Pragma Postcondition,Pragma Post_Class,Pragma Post,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-postcondition}@anchor{bb} +@anchor{gnat_rm/implementation_defined_pragmas pragma-postcondition}@anchor{bd} @section Pragma Postcondition @@ -6301,7 +6318,7 @@ Ada 2012, and has been retained in its original form for compatibility purposes. @node Pragma Post_Class,Pragma Rename_Pragma,Pragma Postcondition,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-post-class}@anchor{bc} +@anchor{gnat_rm/implementation_defined_pragmas pragma-post-class}@anchor{be} @section Pragma Post_Class @@ -6336,7 +6353,7 @@ policy that controls this pragma is @code{Post'Class}, not @code{Post_Class}. @node Pragma Rename_Pragma,Pragma Pre,Pragma Post_Class,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-rename-pragma}@anchor{bd} +@anchor{gnat_rm/implementation_defined_pragmas pragma-rename-pragma}@anchor{bf} @section Pragma Rename_Pragma @@ -6375,7 +6392,7 @@ Pragma Inline_Only will not necessarily mean the same thing as the other Ada compiler; it's up to you to make sure the semantics are close enough. @node Pragma Pre,Pragma Precondition,Pragma Rename_Pragma,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-pre}@anchor{be} +@anchor{gnat_rm/implementation_defined_pragmas pragma-pre}@anchor{c0} @section Pragma Pre @@ -6400,7 +6417,7 @@ appear at the start of the declarations in a subprogram body (preceded only by other pragmas). @node Pragma Precondition,Pragma Predicate,Pragma Pre,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-precondition}@anchor{bf} +@anchor{gnat_rm/implementation_defined_pragmas pragma-precondition}@anchor{c1} @section Pragma Precondition @@ -6459,7 +6476,7 @@ Ada 2012, and has been retained in its original form for compatibility purposes. @node Pragma Predicate,Pragma Predicate_Failure,Pragma Precondition,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas id29}@anchor{c0}@anchor{gnat_rm/implementation_defined_pragmas pragma-predicate}@anchor{c1} +@anchor{gnat_rm/implementation_defined_pragmas pragma-predicate}@anchor{c2}@anchor{gnat_rm/implementation_defined_pragmas id30}@anchor{c3} @section Pragma Predicate @@ -6513,7 +6530,7 @@ defined for subtype B). When following this approach, the use of predicates should be avoided. @node Pragma Predicate_Failure,Pragma Preelaborable_Initialization,Pragma Predicate,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-predicate-failure}@anchor{c2} +@anchor{gnat_rm/implementation_defined_pragmas pragma-predicate-failure}@anchor{c4} @section Pragma Predicate_Failure @@ -6530,7 +6547,7 @@ the language-defined @code{Predicate_Failure} aspect, and shares its restrictions and semantics. @node Pragma Preelaborable_Initialization,Pragma Prefix_Exception_Messages,Pragma Predicate_Failure,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-preelaborable-initialization}@anchor{c3} +@anchor{gnat_rm/implementation_defined_pragmas pragma-preelaborable-initialization}@anchor{c5} @section Pragma Preelaborable_Initialization @@ -6545,7 +6562,7 @@ versions of Ada as an implementation-defined pragma. See Ada 2012 Reference Manual for details. @node Pragma Prefix_Exception_Messages,Pragma Pre_Class,Pragma Preelaborable_Initialization,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-prefix-exception-messages}@anchor{c4} +@anchor{gnat_rm/implementation_defined_pragmas pragma-prefix-exception-messages}@anchor{c6} @section Pragma Prefix_Exception_Messages @@ -6576,7 +6593,7 @@ prefixing in this case, you can always call @code{GNAT.Source_Info.Enclosing_Entity} and prepend the string manually. @node Pragma Pre_Class,Pragma Priority_Specific_Dispatching,Pragma Prefix_Exception_Messages,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-pre-class}@anchor{c5} +@anchor{gnat_rm/implementation_defined_pragmas pragma-pre-class}@anchor{c7} @section Pragma Pre_Class @@ -6611,7 +6628,7 @@ policy that controls this pragma is @code{Pre'Class}, not @code{Pre_Class}. @node Pragma Priority_Specific_Dispatching,Pragma Profile,Pragma Pre_Class,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-priority-specific-dispatching}@anchor{c6} +@anchor{gnat_rm/implementation_defined_pragmas pragma-priority-specific-dispatching}@anchor{c8} @section Pragma Priority_Specific_Dispatching @@ -6635,7 +6652,7 @@ versions of Ada as an implementation-defined pragma. See Ada 2012 Reference Manual for details. @node Pragma Profile,Pragma Profile_Warnings,Pragma Priority_Specific_Dispatching,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-profile}@anchor{c7} +@anchor{gnat_rm/implementation_defined_pragmas pragma-profile}@anchor{c9} @section Pragma Profile @@ -6909,7 +6926,7 @@ conforming Ada constructs. The profile enables the following three pragmas: @end itemize @node Pragma Profile_Warnings,Pragma Propagate_Exceptions,Pragma Profile,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-profile-warnings}@anchor{c8} +@anchor{gnat_rm/implementation_defined_pragmas pragma-profile-warnings}@anchor{ca} @section Pragma Profile_Warnings @@ -6927,7 +6944,7 @@ violations of the profile generate warning messages instead of error messages. @node Pragma Propagate_Exceptions,Pragma Provide_Shift_Operators,Pragma Profile_Warnings,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-propagate-exceptions}@anchor{c9} +@anchor{gnat_rm/implementation_defined_pragmas pragma-propagate-exceptions}@anchor{cb} @section Pragma Propagate_Exceptions @@ -6946,7 +6963,7 @@ purposes. It used to be used in connection with optimization of a now-obsolete mechanism for implementation of exceptions. @node Pragma Provide_Shift_Operators,Pragma Psect_Object,Pragma Propagate_Exceptions,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-provide-shift-operators}@anchor{ca} +@anchor{gnat_rm/implementation_defined_pragmas pragma-provide-shift-operators}@anchor{cc} @section Pragma Provide_Shift_Operators @@ -6966,7 +6983,7 @@ including the function declarations for these five operators, together with the pragma Import (Intrinsic, ...) statements. @node Pragma Psect_Object,Pragma Pure_Function,Pragma Provide_Shift_Operators,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-psect-object}@anchor{cb} +@anchor{gnat_rm/implementation_defined_pragmas pragma-psect-object}@anchor{cd} @section Pragma Psect_Object @@ -6986,7 +7003,7 @@ EXTERNAL_SYMBOL ::= This pragma is identical in effect to pragma @code{Common_Object}. @node Pragma Pure_Function,Pragma Rational,Pragma Psect_Object,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-pure-function}@anchor{cc}@anchor{gnat_rm/implementation_defined_pragmas id30}@anchor{cd} +@anchor{gnat_rm/implementation_defined_pragmas pragma-pure-function}@anchor{ce}@anchor{gnat_rm/implementation_defined_pragmas id31}@anchor{cf} @section Pragma Pure_Function @@ -7048,7 +7065,7 @@ unit is not a Pure unit in the categorization sense. So for example, a function thus marked is free to @code{with} non-pure units. @node Pragma Rational,Pragma Ravenscar,Pragma Pure_Function,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-rational}@anchor{ce} +@anchor{gnat_rm/implementation_defined_pragmas pragma-rational}@anchor{d0} @section Pragma Rational @@ -7066,7 +7083,7 @@ pragma Profile (Rational); @end example @node Pragma Ravenscar,Pragma Refined_Depends,Pragma Rational,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-ravenscar}@anchor{cf} +@anchor{gnat_rm/implementation_defined_pragmas pragma-ravenscar}@anchor{d1} @section Pragma Ravenscar @@ -7086,7 +7103,7 @@ pragma Profile (Ravenscar); which is the preferred method of setting the @code{Ravenscar} profile. @node Pragma Refined_Depends,Pragma Refined_Global,Pragma Ravenscar,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-refined-depends}@anchor{d0}@anchor{gnat_rm/implementation_defined_pragmas id31}@anchor{d1} +@anchor{gnat_rm/implementation_defined_pragmas pragma-refined-depends}@anchor{d2}@anchor{gnat_rm/implementation_defined_pragmas id32}@anchor{d3} @section Pragma Refined_Depends @@ -7119,7 +7136,7 @@ For the semantics of this pragma, see the entry for aspect @code{Refined_Depends the SPARK 2014 Reference Manual, section 6.1.5. @node Pragma Refined_Global,Pragma Refined_Post,Pragma Refined_Depends,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-refined-global}@anchor{d2}@anchor{gnat_rm/implementation_defined_pragmas id32}@anchor{d3} +@anchor{gnat_rm/implementation_defined_pragmas pragma-refined-global}@anchor{d4}@anchor{gnat_rm/implementation_defined_pragmas id33}@anchor{d5} @section Pragma Refined_Global @@ -7144,7 +7161,7 @@ For the semantics of this pragma, see the entry for aspect @code{Refined_Global} the SPARK 2014 Reference Manual, section 6.1.4. @node Pragma Refined_Post,Pragma Refined_State,Pragma Refined_Global,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-refined-post}@anchor{d4}@anchor{gnat_rm/implementation_defined_pragmas id33}@anchor{d5} +@anchor{gnat_rm/implementation_defined_pragmas pragma-refined-post}@anchor{d6}@anchor{gnat_rm/implementation_defined_pragmas id34}@anchor{d7} @section Pragma Refined_Post @@ -7158,7 +7175,7 @@ For the semantics of this pragma, see the entry for aspect @code{Refined_Post} i the SPARK 2014 Reference Manual, section 7.2.7. @node Pragma Refined_State,Pragma Relative_Deadline,Pragma Refined_Post,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-refined-state}@anchor{d6}@anchor{gnat_rm/implementation_defined_pragmas id34}@anchor{d7} +@anchor{gnat_rm/implementation_defined_pragmas pragma-refined-state}@anchor{d8}@anchor{gnat_rm/implementation_defined_pragmas id35}@anchor{d9} @section Pragma Refined_State @@ -7184,7 +7201,7 @@ For the semantics of this pragma, see the entry for aspect @code{Refined_State} the SPARK 2014 Reference Manual, section 7.2.2. @node Pragma Relative_Deadline,Pragma Remote_Access_Type,Pragma Refined_State,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-relative-deadline}@anchor{d8} +@anchor{gnat_rm/implementation_defined_pragmas pragma-relative-deadline}@anchor{da} @section Pragma Relative_Deadline @@ -7199,7 +7216,7 @@ versions of Ada as an implementation-defined pragma. See Ada 2012 Reference Manual for details. @node Pragma Remote_Access_Type,Pragma Restricted_Run_Time,Pragma Relative_Deadline,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas id35}@anchor{d9}@anchor{gnat_rm/implementation_defined_pragmas pragma-remote-access-type}@anchor{da} +@anchor{gnat_rm/implementation_defined_pragmas id36}@anchor{db}@anchor{gnat_rm/implementation_defined_pragmas pragma-remote-access-type}@anchor{dc} @section Pragma Remote_Access_Type @@ -7225,7 +7242,7 @@ pertaining to remote access to class-wide types. At instantiation, the actual type must be a remote access to class-wide type. @node Pragma Restricted_Run_Time,Pragma Restriction_Warnings,Pragma Remote_Access_Type,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-restricted-run-time}@anchor{db} +@anchor{gnat_rm/implementation_defined_pragmas pragma-restricted-run-time}@anchor{dd} @section Pragma Restricted_Run_Time @@ -7246,7 +7263,7 @@ which is the preferred method of setting the restricted run time profile. @node Pragma Restriction_Warnings,Pragma Reviewable,Pragma Restricted_Run_Time,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-restriction-warnings}@anchor{dc} +@anchor{gnat_rm/implementation_defined_pragmas pragma-restriction-warnings}@anchor{de} @section Pragma Restriction_Warnings @@ -7284,7 +7301,7 @@ generating a warning, but any other use of implementation defined pragmas will cause a warning to be generated. @node Pragma Reviewable,Pragma Secondary_Stack_Size,Pragma Restriction_Warnings,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-reviewable}@anchor{dd} +@anchor{gnat_rm/implementation_defined_pragmas pragma-reviewable}@anchor{df} @section Pragma Reviewable @@ -7388,7 +7405,7 @@ comprehensive messages identifying possible problems based on this information. @node Pragma Secondary_Stack_Size,Pragma Share_Generic,Pragma Reviewable,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas id36}@anchor{de}@anchor{gnat_rm/implementation_defined_pragmas pragma-secondary-stack-size}@anchor{df} +@anchor{gnat_rm/implementation_defined_pragmas id37}@anchor{e0}@anchor{gnat_rm/implementation_defined_pragmas pragma-secondary-stack-size}@anchor{e1} @section Pragma Secondary_Stack_Size @@ -7424,7 +7441,7 @@ Note the pragma cannot appear when the restriction @code{No_Secondary_Stack} is in effect. @node Pragma Share_Generic,Pragma Shared,Pragma Secondary_Stack_Size,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-share-generic}@anchor{e0} +@anchor{gnat_rm/implementation_defined_pragmas pragma-share-generic}@anchor{e2} @section Pragma Share_Generic @@ -7442,7 +7459,7 @@ than to check that the given names are all names of generic units or generic instances. @node Pragma Shared,Pragma Short_Circuit_And_Or,Pragma Share_Generic,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas id37}@anchor{e1}@anchor{gnat_rm/implementation_defined_pragmas pragma-shared}@anchor{e2} +@anchor{gnat_rm/implementation_defined_pragmas id38}@anchor{e3}@anchor{gnat_rm/implementation_defined_pragmas pragma-shared}@anchor{e4} @section Pragma Shared @@ -7450,7 +7467,7 @@ This pragma is provided for compatibility with Ada 83. The syntax and semantics are identical to pragma Atomic. @node Pragma Short_Circuit_And_Or,Pragma Short_Descriptors,Pragma Shared,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-short-circuit-and-or}@anchor{e3} +@anchor{gnat_rm/implementation_defined_pragmas pragma-short-circuit-and-or}@anchor{e5} @section Pragma Short_Circuit_And_Or @@ -7469,7 +7486,7 @@ within the file being compiled, it applies only to the file being compiled. There is no requirement that all units in a partition use this option. @node Pragma Short_Descriptors,Pragma Simple_Storage_Pool_Type,Pragma Short_Circuit_And_Or,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-short-descriptors}@anchor{e4} +@anchor{gnat_rm/implementation_defined_pragmas pragma-short-descriptors}@anchor{e6} @section Pragma Short_Descriptors @@ -7483,7 +7500,7 @@ This pragma is provided for compatibility with other Ada implementations. It is recognized but ignored by all current versions of GNAT. @node Pragma Simple_Storage_Pool_Type,Pragma Source_File_Name,Pragma Short_Descriptors,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-simple-storage-pool-type}@anchor{e5}@anchor{gnat_rm/implementation_defined_pragmas id38}@anchor{e6} +@anchor{gnat_rm/implementation_defined_pragmas pragma-simple-storage-pool-type}@anchor{e7}@anchor{gnat_rm/implementation_defined_pragmas id39}@anchor{e8} @section Pragma Simple_Storage_Pool_Type @@ -7537,7 +7554,7 @@ storage-management discipline). An object of a simple storage pool type can be associated with an access type by specifying the attribute -@ref{e7,,Simple_Storage_Pool}. For example: +@ref{e9,,Simple_Storage_Pool}. For example: @example My_Pool : My_Simple_Storage_Pool_Type; @@ -7547,11 +7564,11 @@ type Acc is access My_Data_Type; for Acc'Simple_Storage_Pool use My_Pool; @end example -See attribute @ref{e7,,Simple_Storage_Pool} +See attribute @ref{e9,,Simple_Storage_Pool} for further details. @node Pragma Source_File_Name,Pragma Source_File_Name_Project,Pragma Simple_Storage_Pool_Type,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-source-file-name}@anchor{e8}@anchor{gnat_rm/implementation_defined_pragmas id39}@anchor{e9} +@anchor{gnat_rm/implementation_defined_pragmas pragma-source-file-name}@anchor{ea}@anchor{gnat_rm/implementation_defined_pragmas id40}@anchor{eb} @section Pragma Source_File_Name @@ -7643,19 +7660,19 @@ aware of these pragmas, and so other tools that use the projet file would not be aware of the intended naming conventions. If you are using project files, file naming is controlled by Source_File_Name_Project pragmas, which are usually supplied automatically by the project manager. A pragma -Source_File_Name cannot appear after a @ref{ea,,Pragma Source_File_Name_Project}. +Source_File_Name cannot appear after a @ref{ec,,Pragma Source_File_Name_Project}. For more details on the use of the @code{Source_File_Name} pragma, see the sections on @code{Using Other File Names} and @cite{Alternative File Naming Schemes' in the :title:`GNAT User's Guide}. @node Pragma Source_File_Name_Project,Pragma Source_Reference,Pragma Source_File_Name,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-source-file-name-project}@anchor{ea}@anchor{gnat_rm/implementation_defined_pragmas id40}@anchor{eb} +@anchor{gnat_rm/implementation_defined_pragmas pragma-source-file-name-project}@anchor{ec}@anchor{gnat_rm/implementation_defined_pragmas id41}@anchor{ed} @section Pragma Source_File_Name_Project This pragma has the same syntax and semantics as pragma Source_File_Name. It is only allowed as a stand-alone configuration pragma. -It cannot appear after a @ref{e8,,Pragma Source_File_Name}, and +It cannot appear after a @ref{ea,,Pragma Source_File_Name}, and most importantly, once pragma Source_File_Name_Project appears, no further Source_File_Name pragmas are allowed. @@ -7667,7 +7684,7 @@ Source_File_Name or Source_File_Name_Project pragmas (which would not be known to the project manager). @node Pragma Source_Reference,Pragma SPARK_Mode,Pragma Source_File_Name_Project,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-source-reference}@anchor{ec} +@anchor{gnat_rm/implementation_defined_pragmas pragma-source-reference}@anchor{ee} @section Pragma Source_Reference @@ -7691,7 +7708,7 @@ string expression other than a string literal. This is because its value is needed for error messages issued by all phases of the compiler. @node Pragma SPARK_Mode,Pragma Static_Elaboration_Desired,Pragma Source_Reference,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-spark-mode}@anchor{ed}@anchor{gnat_rm/implementation_defined_pragmas id41}@anchor{ee} +@anchor{gnat_rm/implementation_defined_pragmas pragma-spark-mode}@anchor{ef}@anchor{gnat_rm/implementation_defined_pragmas id42}@anchor{f0} @section Pragma SPARK_Mode @@ -7773,7 +7790,7 @@ SPARK_Mode (@code{Off}), then that pragma will need to be repeated in the package body. @node Pragma Static_Elaboration_Desired,Pragma Stream_Convert,Pragma SPARK_Mode,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-static-elaboration-desired}@anchor{ef} +@anchor{gnat_rm/implementation_defined_pragmas pragma-static-elaboration-desired}@anchor{f1} @section Pragma Static_Elaboration_Desired @@ -7797,7 +7814,7 @@ construction of larger aggregates with static components that include an others choice.) @node Pragma Stream_Convert,Pragma Style_Checks,Pragma Static_Elaboration_Desired,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-stream-convert}@anchor{f0} +@anchor{gnat_rm/implementation_defined_pragmas pragma-stream-convert}@anchor{f2} @section Pragma Stream_Convert @@ -7874,7 +7891,7 @@ the pragma is silently ignored, and the default implementation of the stream attributes is used instead. @node Pragma Style_Checks,Pragma Subtitle,Pragma Stream_Convert,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-style-checks}@anchor{f1} +@anchor{gnat_rm/implementation_defined_pragmas pragma-style-checks}@anchor{f3} @section Pragma Style_Checks @@ -7947,7 +7964,7 @@ Rf2 : Integer := ARG; -- OK, no error @end example @node Pragma Subtitle,Pragma Suppress,Pragma Style_Checks,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-subtitle}@anchor{f2} +@anchor{gnat_rm/implementation_defined_pragmas pragma-subtitle}@anchor{f4} @section Pragma Subtitle @@ -7961,7 +7978,7 @@ This pragma is recognized for compatibility with other Ada compilers but is ignored by GNAT. @node Pragma Suppress,Pragma Suppress_All,Pragma Subtitle,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-suppress}@anchor{f3} +@anchor{gnat_rm/implementation_defined_pragmas pragma-suppress}@anchor{f5} @section Pragma Suppress @@ -8034,7 +8051,7 @@ Of course, run-time checks are omitted whenever the compiler can prove that they will not fail, whether or not checks are suppressed. @node Pragma Suppress_All,Pragma Suppress_Debug_Info,Pragma Suppress,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-suppress-all}@anchor{f4} +@anchor{gnat_rm/implementation_defined_pragmas pragma-suppress-all}@anchor{f6} @section Pragma Suppress_All @@ -8053,7 +8070,7 @@ The use of the standard Ada pragma @code{Suppress (All_Checks)} as a normal configuration pragma is the preferred usage in GNAT. @node Pragma Suppress_Debug_Info,Pragma Suppress_Exception_Locations,Pragma Suppress_All,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-suppress-debug-info}@anchor{f5}@anchor{gnat_rm/implementation_defined_pragmas id42}@anchor{f6} +@anchor{gnat_rm/implementation_defined_pragmas pragma-suppress-debug-info}@anchor{f7}@anchor{gnat_rm/implementation_defined_pragmas id43}@anchor{f8} @section Pragma Suppress_Debug_Info @@ -8068,7 +8085,7 @@ for the specified entity. It is intended primarily for use in debugging the debugger, and navigating around debugger problems. @node Pragma Suppress_Exception_Locations,Pragma Suppress_Initialization,Pragma Suppress_Debug_Info,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-suppress-exception-locations}@anchor{f7} +@anchor{gnat_rm/implementation_defined_pragmas pragma-suppress-exception-locations}@anchor{f9} @section Pragma Suppress_Exception_Locations @@ -8091,7 +8108,7 @@ a partition, so it is fine to have some units within a partition compiled with this pragma and others compiled in normal mode without it. @node Pragma Suppress_Initialization,Pragma Task_Name,Pragma Suppress_Exception_Locations,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas id43}@anchor{f8}@anchor{gnat_rm/implementation_defined_pragmas pragma-suppress-initialization}@anchor{f9} +@anchor{gnat_rm/implementation_defined_pragmas id44}@anchor{fa}@anchor{gnat_rm/implementation_defined_pragmas pragma-suppress-initialization}@anchor{fb} @section Pragma Suppress_Initialization @@ -8136,7 +8153,7 @@ is suppressed, just as though its subtype had been given in a pragma Suppress_Initialization, as described above. @node Pragma Task_Name,Pragma Task_Storage,Pragma Suppress_Initialization,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-task-name}@anchor{fa} +@anchor{gnat_rm/implementation_defined_pragmas pragma-task-name}@anchor{fc} @section Pragma Task_Name @@ -8192,7 +8209,7 @@ end; @end example @node Pragma Task_Storage,Pragma Test_Case,Pragma Task_Name,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-task-storage}@anchor{fb} +@anchor{gnat_rm/implementation_defined_pragmas pragma-task-storage}@anchor{fd} @section Pragma Task_Storage @@ -8212,7 +8229,7 @@ created, depending on the target. This pragma can appear anywhere a type. @node Pragma Test_Case,Pragma Thread_Local_Storage,Pragma Task_Storage,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-test-case}@anchor{fc}@anchor{gnat_rm/implementation_defined_pragmas id44}@anchor{fd} +@anchor{gnat_rm/implementation_defined_pragmas pragma-test-case}@anchor{fe}@anchor{gnat_rm/implementation_defined_pragmas id45}@anchor{ff} @section Pragma Test_Case @@ -8268,7 +8285,7 @@ postcondition. Mode @code{Robustness} indicates that the precondition and postcondition of the subprogram should be ignored for this test case. @node Pragma Thread_Local_Storage,Pragma Time_Slice,Pragma Test_Case,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-thread-local-storage}@anchor{fe}@anchor{gnat_rm/implementation_defined_pragmas id45}@anchor{ff} +@anchor{gnat_rm/implementation_defined_pragmas pragma-thread-local-storage}@anchor{100}@anchor{gnat_rm/implementation_defined_pragmas id46}@anchor{101} @section Pragma Thread_Local_Storage @@ -8306,7 +8323,7 @@ If this pragma is used on a system where @code{TLS} is not supported, then an error message will be generated and the program will be rejected. @node Pragma Time_Slice,Pragma Title,Pragma Thread_Local_Storage,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-time-slice}@anchor{100} +@anchor{gnat_rm/implementation_defined_pragmas pragma-time-slice}@anchor{102} @section Pragma Time_Slice @@ -8322,7 +8339,7 @@ It is ignored if it is used in a system that does not allow this control, or if it appears in other than the main program unit. @node Pragma Title,Pragma Type_Invariant,Pragma Time_Slice,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-title}@anchor{101} +@anchor{gnat_rm/implementation_defined_pragmas pragma-title}@anchor{103} @section Pragma Title @@ -8347,7 +8364,7 @@ notation is used, and named and positional notation can be mixed following the normal rules for procedure calls in Ada. @node Pragma Type_Invariant,Pragma Type_Invariant_Class,Pragma Title,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-type-invariant}@anchor{102} +@anchor{gnat_rm/implementation_defined_pragmas pragma-type-invariant}@anchor{104} @section Pragma Type_Invariant @@ -8368,7 +8385,7 @@ controlled by the assertion identifier @code{Type_Invariant} rather than @code{Invariant}. @node Pragma Type_Invariant_Class,Pragma Unchecked_Union,Pragma Type_Invariant,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas id46}@anchor{103}@anchor{gnat_rm/implementation_defined_pragmas pragma-type-invariant-class}@anchor{104} +@anchor{gnat_rm/implementation_defined_pragmas id47}@anchor{105}@anchor{gnat_rm/implementation_defined_pragmas pragma-type-invariant-class}@anchor{106} @section Pragma Type_Invariant_Class @@ -8395,7 +8412,7 @@ policy that controls this pragma is @code{Type_Invariant'Class}, not @code{Type_Invariant_Class}. @node Pragma Unchecked_Union,Pragma Unevaluated_Use_Of_Old,Pragma Type_Invariant_Class,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-unchecked-union}@anchor{105} +@anchor{gnat_rm/implementation_defined_pragmas pragma-unchecked-union}@anchor{107} @section Pragma Unchecked_Union @@ -8415,7 +8432,7 @@ version in all language modes (Ada 83, Ada 95, and Ada 2005). For full details, consult the Ada 2012 Reference Manual, section B.3.3. @node Pragma Unevaluated_Use_Of_Old,Pragma Unimplemented_Unit,Pragma Unchecked_Union,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-unevaluated-use-of-old}@anchor{106} +@anchor{gnat_rm/implementation_defined_pragmas pragma-unevaluated-use-of-old}@anchor{108} @section Pragma Unevaluated_Use_Of_Old @@ -8470,7 +8487,7 @@ uses up to the end of the corresponding statement sequence or sequence of package declarations. @node Pragma Unimplemented_Unit,Pragma Universal_Aliasing,Pragma Unevaluated_Use_Of_Old,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-unimplemented-unit}@anchor{107} +@anchor{gnat_rm/implementation_defined_pragmas pragma-unimplemented-unit}@anchor{109} @section Pragma Unimplemented_Unit @@ -8490,7 +8507,7 @@ The abort only happens if code is being generated. Thus you can use specs of unimplemented packages in syntax or semantic checking mode. @node Pragma Universal_Aliasing,Pragma Universal_Data,Pragma Unimplemented_Unit,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas id47}@anchor{108}@anchor{gnat_rm/implementation_defined_pragmas pragma-universal-aliasing}@anchor{109} +@anchor{gnat_rm/implementation_defined_pragmas pragma-universal-aliasing}@anchor{10a}@anchor{gnat_rm/implementation_defined_pragmas id48}@anchor{10b} @section Pragma Universal_Aliasing @@ -8509,7 +8526,7 @@ situations in which it must be suppressed, see the section on @code{Optimization and Strict Aliasing} in the @cite{GNAT User's Guide}. @node Pragma Universal_Data,Pragma Unmodified,Pragma Universal_Aliasing,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-universal-data}@anchor{10a}@anchor{gnat_rm/implementation_defined_pragmas id48}@anchor{10b} +@anchor{gnat_rm/implementation_defined_pragmas pragma-universal-data}@anchor{10c}@anchor{gnat_rm/implementation_defined_pragmas id49}@anchor{10d} @section Pragma Universal_Data @@ -8533,7 +8550,7 @@ of this pragma is also available by applying the -univ switch on the compilations of units where universal addressing of the data is desired. @node Pragma Unmodified,Pragma Unreferenced,Pragma Universal_Data,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-unmodified}@anchor{10c}@anchor{gnat_rm/implementation_defined_pragmas id49}@anchor{10d} +@anchor{gnat_rm/implementation_defined_pragmas id50}@anchor{10e}@anchor{gnat_rm/implementation_defined_pragmas pragma-unmodified}@anchor{10f} @section Pragma Unmodified @@ -8567,7 +8584,7 @@ Thus it is never necessary to use @code{pragma Unmodified} for such variables, though it is harmless to do so. @node Pragma Unreferenced,Pragma Unreferenced_Objects,Pragma Unmodified,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-unreferenced}@anchor{10e}@anchor{gnat_rm/implementation_defined_pragmas id50}@anchor{10f} +@anchor{gnat_rm/implementation_defined_pragmas pragma-unreferenced}@anchor{110}@anchor{gnat_rm/implementation_defined_pragmas id51}@anchor{111} @section Pragma Unreferenced @@ -8611,7 +8628,7 @@ Note that if a warning is desired for all calls to a given subprogram, regardless of whether they occur in the same unit as the subprogram declaration, then this pragma should not be used (calls from another unit would not be flagged); pragma Obsolescent can be used instead -for this purpose, see @ref{ad,,Pragma Obsolescent}. +for this purpose, see @ref{af,,Pragma Obsolescent}. The second form of pragma @code{Unreferenced} is used within a context clause. In this case the arguments must be unit names of units previously @@ -8627,7 +8644,7 @@ Thus it is never necessary to use @code{pragma Unreferenced} for such variables, though it is harmless to do so. @node Pragma Unreferenced_Objects,Pragma Unreserve_All_Interrupts,Pragma Unreferenced,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-unreferenced-objects}@anchor{110}@anchor{gnat_rm/implementation_defined_pragmas id51}@anchor{111} +@anchor{gnat_rm/implementation_defined_pragmas pragma-unreferenced-objects}@anchor{112}@anchor{gnat_rm/implementation_defined_pragmas id52}@anchor{113} @section Pragma Unreferenced_Objects @@ -8652,7 +8669,7 @@ compiler will automatically suppress unwanted warnings about these variables not being referenced. @node Pragma Unreserve_All_Interrupts,Pragma Unsuppress,Pragma Unreferenced_Objects,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-unreserve-all-interrupts}@anchor{112} +@anchor{gnat_rm/implementation_defined_pragmas pragma-unreserve-all-interrupts}@anchor{114} @section Pragma Unreserve_All_Interrupts @@ -8688,7 +8705,7 @@ handled, see pragma @code{Interrupt_State}, which subsumes the functionality of the @code{Unreserve_All_Interrupts} pragma. @node Pragma Unsuppress,Pragma Use_VADS_Size,Pragma Unreserve_All_Interrupts,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-unsuppress}@anchor{113} +@anchor{gnat_rm/implementation_defined_pragmas pragma-unsuppress}@anchor{115} @section Pragma Unsuppress @@ -8724,7 +8741,7 @@ number of implementation-defined check names. See the description of pragma @code{Suppress} for full details. @node Pragma Use_VADS_Size,Pragma Unused,Pragma Unsuppress,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-use-vads-size}@anchor{114} +@anchor{gnat_rm/implementation_defined_pragmas pragma-use-vads-size}@anchor{116} @section Pragma Use_VADS_Size @@ -8748,7 +8765,7 @@ as implemented in the VADS compiler. See description of the VADS_Size attribute for further details. @node Pragma Unused,Pragma Validity_Checks,Pragma Use_VADS_Size,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-unused}@anchor{115}@anchor{gnat_rm/implementation_defined_pragmas id52}@anchor{116} +@anchor{gnat_rm/implementation_defined_pragmas pragma-unused}@anchor{117}@anchor{gnat_rm/implementation_defined_pragmas id53}@anchor{118} @section Pragma Unused @@ -8782,7 +8799,7 @@ Thus it is never necessary to use @code{pragma Unmodified} for such variables, though it is harmless to do so. @node Pragma Validity_Checks,Pragma Volatile,Pragma Unused,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-validity-checks}@anchor{117} +@anchor{gnat_rm/implementation_defined_pragmas pragma-validity-checks}@anchor{119} @section Pragma Validity_Checks @@ -8838,7 +8855,7 @@ A := C; -- C will be validity checked @end example @node Pragma Volatile,Pragma Volatile_Full_Access,Pragma Validity_Checks,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-volatile}@anchor{118} +@anchor{gnat_rm/implementation_defined_pragmas id54}@anchor{11a}@anchor{gnat_rm/implementation_defined_pragmas pragma-volatile}@anchor{11b} @section Pragma Volatile @@ -8856,7 +8873,7 @@ implementation of pragma Volatile is upwards compatible with the implementation in DEC Ada 83. @node Pragma Volatile_Full_Access,Pragma Volatile_Function,Pragma Volatile,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-volatile-full-access}@anchor{119}@anchor{gnat_rm/implementation_defined_pragmas id53}@anchor{11a} +@anchor{gnat_rm/implementation_defined_pragmas id55}@anchor{11c}@anchor{gnat_rm/implementation_defined_pragmas pragma-volatile-full-access}@anchor{11d} @section Pragma Volatile_Full_Access @@ -8888,7 +8905,7 @@ It is not permissible to specify @code{Volatile_Full_Access} for a composite (record or array) type or object that has at least one @code{Aliased} component. @node Pragma Volatile_Function,Pragma Warning_As_Error,Pragma Volatile_Full_Access,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas id54}@anchor{11b}@anchor{gnat_rm/implementation_defined_pragmas pragma-volatile-function}@anchor{11c} +@anchor{gnat_rm/implementation_defined_pragmas id56}@anchor{11e}@anchor{gnat_rm/implementation_defined_pragmas pragma-volatile-function}@anchor{11f} @section Pragma Volatile_Function @@ -8902,7 +8919,7 @@ For the semantics of this pragma, see the entry for aspect @code{Volatile_Functi in the SPARK 2014 Reference Manual, section 7.1.2. @node Pragma Warning_As_Error,Pragma Warnings,Pragma Volatile_Function,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-warning-as-error}@anchor{11d} +@anchor{gnat_rm/implementation_defined_pragmas pragma-warning-as-error}@anchor{120} @section Pragma Warning_As_Error @@ -8937,7 +8954,7 @@ as shown in the example below, to treat a class of warnings as errors. The above use of patterns to match the message applies only to warning messages generated by the front end. This pragma can also be applied to -warnings provided by the back end and mentioned in @ref{11e,,Pragma Warnings}. +warnings provided by the back end and mentioned in @ref{121,,Pragma Warnings}. By using a single full @emph{-Wxxx} switch in the pragma, such warnings can also be treated as errors. @@ -8987,7 +9004,7 @@ the tag is changed from "warning:" to "error:" and the string "[warning-as-error]" is appended to the end of the message. @node Pragma Warnings,Pragma Weak_External,Pragma Warning_As_Error,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas id55}@anchor{11f}@anchor{gnat_rm/implementation_defined_pragmas pragma-warnings}@anchor{11e} +@anchor{gnat_rm/implementation_defined_pragmas id57}@anchor{122}@anchor{gnat_rm/implementation_defined_pragmas pragma-warnings}@anchor{121} @section Pragma Warnings @@ -9143,7 +9160,7 @@ selectively for each tool, and as a consequence to detect useless pragma Warnings with switch @code{-gnatw.w}. @node Pragma Weak_External,Pragma Wide_Character_Encoding,Pragma Warnings,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-weak-external}@anchor{120} +@anchor{gnat_rm/implementation_defined_pragmas pragma-weak-external}@anchor{123} @section Pragma Weak_External @@ -9194,7 +9211,7 @@ end External_Module; @end example @node Pragma Wide_Character_Encoding,,Pragma Weak_External,Implementation Defined Pragmas -@anchor{gnat_rm/implementation_defined_pragmas pragma-wide-character-encoding}@anchor{121} +@anchor{gnat_rm/implementation_defined_pragmas pragma-wide-character-encoding}@anchor{124} @section Pragma Wide_Character_Encoding @@ -9225,7 +9242,7 @@ encoding within that file, and does not affect withed units, specs, or subunits. @node Implementation Defined Aspects,Implementation Defined Attributes,Implementation Defined Pragmas,Top -@anchor{gnat_rm/implementation_defined_aspects implementation-defined-aspects}@anchor{122}@anchor{gnat_rm/implementation_defined_aspects doc}@anchor{123}@anchor{gnat_rm/implementation_defined_aspects id1}@anchor{124} +@anchor{gnat_rm/implementation_defined_aspects implementation-defined-aspects}@anchor{125}@anchor{gnat_rm/implementation_defined_aspects doc}@anchor{126}@anchor{gnat_rm/implementation_defined_aspects id1}@anchor{127} @chapter Implementation Defined Aspects @@ -9306,6 +9323,7 @@ or attribute definition clause. * Aspect Linker_Section:: * Aspect Lock_Free:: * Aspect Max_Queue_Length:: +* Aspect No_Caching:: * Aspect No_Elaboration_Code_All:: * Aspect No_Inline:: * Aspect No_Tagged_Streams:: @@ -9343,7 +9361,7 @@ or attribute definition clause. @end menu @node Aspect Abstract_State,Aspect Annotate,,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-abstract-state}@anchor{125} +@anchor{gnat_rm/implementation_defined_aspects aspect-abstract-state}@anchor{128} @section Aspect Abstract_State @@ -9352,7 +9370,7 @@ or attribute definition clause. This aspect is equivalent to @ref{1c,,pragma Abstract_State}. @node Aspect Annotate,Aspect Async_Readers,Aspect Abstract_State,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-annotate}@anchor{126} +@anchor{gnat_rm/implementation_defined_aspects aspect-annotate}@anchor{129} @section Aspect Annotate @@ -9379,7 +9397,7 @@ Equivalent to @code{pragma Annotate (ID, ID @{, ARG@}, Entity => Name);} @end table @node Aspect Async_Readers,Aspect Async_Writers,Aspect Annotate,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-async-readers}@anchor{127} +@anchor{gnat_rm/implementation_defined_aspects aspect-async-readers}@anchor{12a} @section Aspect Async_Readers @@ -9388,7 +9406,7 @@ Equivalent to @code{pragma Annotate (ID, ID @{, ARG@}, Entity => Name);} This boolean aspect is equivalent to @ref{30,,pragma Async_Readers}. @node Aspect Async_Writers,Aspect Constant_After_Elaboration,Aspect Async_Readers,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-async-writers}@anchor{128} +@anchor{gnat_rm/implementation_defined_aspects aspect-async-writers}@anchor{12b} @section Aspect Async_Writers @@ -9397,7 +9415,7 @@ This boolean aspect is equivalent to @ref{30,,pragma Async_Readers}. This boolean aspect is equivalent to @ref{33,,pragma Async_Writers}. @node Aspect Constant_After_Elaboration,Aspect Contract_Cases,Aspect Async_Writers,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-constant-after-elaboration}@anchor{129} +@anchor{gnat_rm/implementation_defined_aspects aspect-constant-after-elaboration}@anchor{12c} @section Aspect Constant_After_Elaboration @@ -9406,7 +9424,7 @@ This boolean aspect is equivalent to @ref{33,,pragma Async_Writers}. This aspect is equivalent to @ref{44,,pragma Constant_After_Elaboration}. @node Aspect Contract_Cases,Aspect Depends,Aspect Constant_After_Elaboration,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-contract-cases}@anchor{12a} +@anchor{gnat_rm/implementation_defined_aspects aspect-contract-cases}@anchor{12d} @section Aspect Contract_Cases @@ -9417,7 +9435,7 @@ of clauses being enclosed in parentheses so that syntactically it is an aggregate. @node Aspect Depends,Aspect Default_Initial_Condition,Aspect Contract_Cases,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-depends}@anchor{12b} +@anchor{gnat_rm/implementation_defined_aspects aspect-depends}@anchor{12e} @section Aspect Depends @@ -9426,7 +9444,7 @@ aggregate. This aspect is equivalent to @ref{55,,pragma Depends}. @node Aspect Default_Initial_Condition,Aspect Dimension,Aspect Depends,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-default-initial-condition}@anchor{12c} +@anchor{gnat_rm/implementation_defined_aspects aspect-default-initial-condition}@anchor{12f} @section Aspect Default_Initial_Condition @@ -9435,7 +9453,7 @@ This aspect is equivalent to @ref{55,,pragma Depends}. This aspect is equivalent to @ref{50,,pragma Default_Initial_Condition}. @node Aspect Dimension,Aspect Dimension_System,Aspect Default_Initial_Condition,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-dimension}@anchor{12d} +@anchor{gnat_rm/implementation_defined_aspects aspect-dimension}@anchor{130} @section Aspect Dimension @@ -9471,7 +9489,7 @@ Note that when the dimensioned type is an integer type, then any dimension value must be an integer literal. @node Aspect Dimension_System,Aspect Disable_Controlled,Aspect Dimension,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-dimension-system}@anchor{12e} +@anchor{gnat_rm/implementation_defined_aspects aspect-dimension-system}@anchor{131} @section Aspect Dimension_System @@ -9531,7 +9549,7 @@ See section 'Performing Dimensionality Analysis in GNAT' in the GNAT Users Guide for detailed examples of use of the dimension system. @node Aspect Disable_Controlled,Aspect Effective_Reads,Aspect Dimension_System,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-disable-controlled}@anchor{12f} +@anchor{gnat_rm/implementation_defined_aspects aspect-disable-controlled}@anchor{132} @section Aspect Disable_Controlled @@ -9544,7 +9562,7 @@ where for example you might want a record to be controlled or not depending on whether some run-time check is enabled or suppressed. @node Aspect Effective_Reads,Aspect Effective_Writes,Aspect Disable_Controlled,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-effective-reads}@anchor{130} +@anchor{gnat_rm/implementation_defined_aspects aspect-effective-reads}@anchor{133} @section Aspect Effective_Reads @@ -9553,7 +9571,7 @@ whether some run-time check is enabled or suppressed. This aspect is equivalent to @ref{5b,,pragma Effective_Reads}. @node Aspect Effective_Writes,Aspect Extensions_Visible,Aspect Effective_Reads,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-effective-writes}@anchor{131} +@anchor{gnat_rm/implementation_defined_aspects aspect-effective-writes}@anchor{134} @section Aspect Effective_Writes @@ -9562,7 +9580,7 @@ This aspect is equivalent to @ref{5b,,pragma Effective_Reads}. This aspect is equivalent to @ref{5d,,pragma Effective_Writes}. @node Aspect Extensions_Visible,Aspect Favor_Top_Level,Aspect Effective_Writes,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-extensions-visible}@anchor{132} +@anchor{gnat_rm/implementation_defined_aspects aspect-extensions-visible}@anchor{135} @section Aspect Extensions_Visible @@ -9571,7 +9589,7 @@ This aspect is equivalent to @ref{5d,,pragma Effective_Writes}. This aspect is equivalent to @ref{69,,pragma Extensions_Visible}. @node Aspect Favor_Top_Level,Aspect Ghost,Aspect Extensions_Visible,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-favor-top-level}@anchor{133} +@anchor{gnat_rm/implementation_defined_aspects aspect-favor-top-level}@anchor{136} @section Aspect Favor_Top_Level @@ -9580,7 +9598,7 @@ This aspect is equivalent to @ref{69,,pragma Extensions_Visible}. This boolean aspect is equivalent to @ref{6e,,pragma Favor_Top_Level}. @node Aspect Ghost,Aspect Global,Aspect Favor_Top_Level,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-ghost}@anchor{134} +@anchor{gnat_rm/implementation_defined_aspects aspect-ghost}@anchor{137} @section Aspect Ghost @@ -9589,7 +9607,7 @@ This boolean aspect is equivalent to @ref{6e,,pragma Favor_Top_Level}. This aspect is equivalent to @ref{71,,pragma Ghost}. @node Aspect Global,Aspect Initial_Condition,Aspect Ghost,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-global}@anchor{135} +@anchor{gnat_rm/implementation_defined_aspects aspect-global}@anchor{138} @section Aspect Global @@ -9598,7 +9616,7 @@ This aspect is equivalent to @ref{71,,pragma Ghost}. This aspect is equivalent to @ref{73,,pragma Global}. @node Aspect Initial_Condition,Aspect Initializes,Aspect Global,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-initial-condition}@anchor{136} +@anchor{gnat_rm/implementation_defined_aspects aspect-initial-condition}@anchor{139} @section Aspect Initial_Condition @@ -9607,7 +9625,7 @@ This aspect is equivalent to @ref{73,,pragma Global}. This aspect is equivalent to @ref{81,,pragma Initial_Condition}. @node Aspect Initializes,Aspect Inline_Always,Aspect Initial_Condition,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-initializes}@anchor{137} +@anchor{gnat_rm/implementation_defined_aspects aspect-initializes}@anchor{13a} @section Aspect Initializes @@ -9616,7 +9634,7 @@ This aspect is equivalent to @ref{81,,pragma Initial_Condition}. This aspect is equivalent to @ref{83,,pragma Initializes}. @node Aspect Inline_Always,Aspect Invariant,Aspect Initializes,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-inline-always}@anchor{138} +@anchor{gnat_rm/implementation_defined_aspects aspect-inline-always}@anchor{13b} @section Aspect Inline_Always @@ -9625,7 +9643,7 @@ This aspect is equivalent to @ref{83,,pragma Initializes}. This boolean aspect is equivalent to @ref{86,,pragma Inline_Always}. @node Aspect Invariant,Aspect Invariant'Class,Aspect Inline_Always,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-invariant}@anchor{139} +@anchor{gnat_rm/implementation_defined_aspects aspect-invariant}@anchor{13c} @section Aspect Invariant @@ -9636,18 +9654,18 @@ synonym for the language defined aspect @code{Type_Invariant} except that it is separately controllable using pragma @code{Assertion_Policy}. @node Aspect Invariant'Class,Aspect Iterable,Aspect Invariant,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-invariant-class}@anchor{13a} +@anchor{gnat_rm/implementation_defined_aspects aspect-invariant-class}@anchor{13d} @section Aspect Invariant'Class @geindex Invariant'Class -This aspect is equivalent to @ref{104,,pragma Type_Invariant_Class}. It is a +This aspect is equivalent to @ref{106,,pragma Type_Invariant_Class}. It is a synonym for the language defined aspect @code{Type_Invariant'Class} except that it is separately controllable using pragma @code{Assertion_Policy}. @node Aspect Iterable,Aspect Linker_Section,Aspect Invariant'Class,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-iterable}@anchor{13b} +@anchor{gnat_rm/implementation_defined_aspects aspect-iterable}@anchor{13e} @section Aspect Iterable @@ -9727,7 +9745,7 @@ function Get_Element (Cont : Container; Position : Cursor) return Element_Type; This aspect is used in the GNAT-defined formal container packages. @node Aspect Linker_Section,Aspect Lock_Free,Aspect Iterable,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-linker-section}@anchor{13c} +@anchor{gnat_rm/implementation_defined_aspects aspect-linker-section}@anchor{13f} @section Aspect Linker_Section @@ -9736,7 +9754,7 @@ This aspect is used in the GNAT-defined formal container packages. This aspect is equivalent to @ref{95,,pragma Linker_Section}. @node Aspect Lock_Free,Aspect Max_Queue_Length,Aspect Linker_Section,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-lock-free}@anchor{13d} +@anchor{gnat_rm/implementation_defined_aspects aspect-lock-free}@anchor{140} @section Aspect Lock_Free @@ -9744,8 +9762,8 @@ This aspect is equivalent to @ref{95,,pragma Linker_Section}. This boolean aspect is equivalent to @ref{97,,pragma Lock_Free}. -@node Aspect Max_Queue_Length,Aspect No_Elaboration_Code_All,Aspect Lock_Free,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-max-queue-length}@anchor{13e} +@node Aspect Max_Queue_Length,Aspect No_Caching,Aspect Lock_Free,Implementation Defined Aspects +@anchor{gnat_rm/implementation_defined_aspects aspect-max-queue-length}@anchor{141} @section Aspect Max_Queue_Length @@ -9753,82 +9771,91 @@ This boolean aspect is equivalent to @ref{97,,pragma Lock_Free}. This aspect is equivalent to @ref{9f,,pragma Max_Queue_Length}. -@node Aspect No_Elaboration_Code_All,Aspect No_Inline,Aspect Max_Queue_Length,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-no-elaboration-code-all}@anchor{13f} +@node Aspect No_Caching,Aspect No_Elaboration_Code_All,Aspect Max_Queue_Length,Implementation Defined Aspects +@anchor{gnat_rm/implementation_defined_aspects aspect-no-caching}@anchor{142} +@section Aspect No_Caching + + +@geindex No_Caching + +This boolean aspect is equivalent to @ref{a1,,pragma No_Caching}. + +@node Aspect No_Elaboration_Code_All,Aspect No_Inline,Aspect No_Caching,Implementation Defined Aspects +@anchor{gnat_rm/implementation_defined_aspects aspect-no-elaboration-code-all}@anchor{143} @section Aspect No_Elaboration_Code_All @geindex No_Elaboration_Code_All -This aspect is equivalent to @ref{a3,,pragma No_Elaboration_Code_All} +This aspect is equivalent to @ref{a5,,pragma No_Elaboration_Code_All} for a program unit. @node Aspect No_Inline,Aspect No_Tagged_Streams,Aspect No_Elaboration_Code_All,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-no-inline}@anchor{140} +@anchor{gnat_rm/implementation_defined_aspects aspect-no-inline}@anchor{144} @section Aspect No_Inline @geindex No_Inline -This boolean aspect is equivalent to @ref{a6,,pragma No_Inline}. +This boolean aspect is equivalent to @ref{a8,,pragma No_Inline}. @node Aspect No_Tagged_Streams,Aspect Object_Size,Aspect No_Inline,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-no-tagged-streams}@anchor{141} +@anchor{gnat_rm/implementation_defined_aspects aspect-no-tagged-streams}@anchor{145} @section Aspect No_Tagged_Streams @geindex No_Tagged_Streams -This aspect is equivalent to @ref{aa,,pragma No_Tagged_Streams} with an +This aspect is equivalent to @ref{ac,,pragma No_Tagged_Streams} with an argument specifying a root tagged type (thus this aspect can only be applied to such a type). @node Aspect Object_Size,Aspect Obsolescent,Aspect No_Tagged_Streams,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-object-size}@anchor{142} +@anchor{gnat_rm/implementation_defined_aspects aspect-object-size}@anchor{146} @section Aspect Object_Size @geindex Object_Size -This aspect is equivalent to @ref{143,,attribute Object_Size}. +This aspect is equivalent to @ref{147,,attribute Object_Size}. @node Aspect Obsolescent,Aspect Part_Of,Aspect Object_Size,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-obsolescent}@anchor{144} +@anchor{gnat_rm/implementation_defined_aspects aspect-obsolescent}@anchor{148} @section Aspect Obsolescent @geindex Obsolsecent -This aspect is equivalent to @ref{ad,,pragma Obsolescent}. Note that the +This aspect is equivalent to @ref{af,,pragma Obsolescent}. Note that the evaluation of this aspect happens at the point of occurrence, it is not delayed until the freeze point. @node Aspect Part_Of,Aspect Persistent_BSS,Aspect Obsolescent,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-part-of}@anchor{145} +@anchor{gnat_rm/implementation_defined_aspects aspect-part-of}@anchor{149} @section Aspect Part_Of @geindex Part_Of -This aspect is equivalent to @ref{b5,,pragma Part_Of}. +This aspect is equivalent to @ref{b7,,pragma Part_Of}. @node Aspect Persistent_BSS,Aspect Predicate,Aspect Part_Of,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-persistent-bss}@anchor{146} +@anchor{gnat_rm/implementation_defined_aspects aspect-persistent-bss}@anchor{14a} @section Aspect Persistent_BSS @geindex Persistent_BSS -This boolean aspect is equivalent to @ref{b8,,pragma Persistent_BSS}. +This boolean aspect is equivalent to @ref{ba,,pragma Persistent_BSS}. @node Aspect Predicate,Aspect Pure_Function,Aspect Persistent_BSS,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-predicate}@anchor{147} +@anchor{gnat_rm/implementation_defined_aspects aspect-predicate}@anchor{14b} @section Aspect Predicate @geindex Predicate -This aspect is equivalent to @ref{c1,,pragma Predicate}. It is thus +This aspect is equivalent to @ref{c2,,pragma Predicate}. It is thus similar to the language defined aspects @code{Dynamic_Predicate} and @code{Static_Predicate} except that whether the resulting predicate is static or dynamic is controlled by the form of the @@ -9836,239 +9863,239 @@ expression. It is also separately controllable using pragma @code{Assertion_Policy}. @node Aspect Pure_Function,Aspect Refined_Depends,Aspect Predicate,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-pure-function}@anchor{148} +@anchor{gnat_rm/implementation_defined_aspects aspect-pure-function}@anchor{14c} @section Aspect Pure_Function @geindex Pure_Function -This boolean aspect is equivalent to @ref{cc,,pragma Pure_Function}. +This boolean aspect is equivalent to @ref{ce,,pragma Pure_Function}. @node Aspect Refined_Depends,Aspect Refined_Global,Aspect Pure_Function,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-refined-depends}@anchor{149} +@anchor{gnat_rm/implementation_defined_aspects aspect-refined-depends}@anchor{14d} @section Aspect Refined_Depends @geindex Refined_Depends -This aspect is equivalent to @ref{d0,,pragma Refined_Depends}. +This aspect is equivalent to @ref{d2,,pragma Refined_Depends}. @node Aspect Refined_Global,Aspect Refined_Post,Aspect Refined_Depends,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-refined-global}@anchor{14a} +@anchor{gnat_rm/implementation_defined_aspects aspect-refined-global}@anchor{14e} @section Aspect Refined_Global @geindex Refined_Global -This aspect is equivalent to @ref{d2,,pragma Refined_Global}. +This aspect is equivalent to @ref{d4,,pragma Refined_Global}. @node Aspect Refined_Post,Aspect Refined_State,Aspect Refined_Global,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-refined-post}@anchor{14b} +@anchor{gnat_rm/implementation_defined_aspects aspect-refined-post}@anchor{14f} @section Aspect Refined_Post @geindex Refined_Post -This aspect is equivalent to @ref{d4,,pragma Refined_Post}. +This aspect is equivalent to @ref{d6,,pragma Refined_Post}. @node Aspect Refined_State,Aspect Remote_Access_Type,Aspect Refined_Post,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-refined-state}@anchor{14c} +@anchor{gnat_rm/implementation_defined_aspects aspect-refined-state}@anchor{150} @section Aspect Refined_State @geindex Refined_State -This aspect is equivalent to @ref{d6,,pragma Refined_State}. +This aspect is equivalent to @ref{d8,,pragma Refined_State}. @node Aspect Remote_Access_Type,Aspect Secondary_Stack_Size,Aspect Refined_State,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-remote-access-type}@anchor{14d} +@anchor{gnat_rm/implementation_defined_aspects aspect-remote-access-type}@anchor{151} @section Aspect Remote_Access_Type @geindex Remote_Access_Type -This aspect is equivalent to @ref{da,,pragma Remote_Access_Type}. +This aspect is equivalent to @ref{dc,,pragma Remote_Access_Type}. @node Aspect Secondary_Stack_Size,Aspect Scalar_Storage_Order,Aspect Remote_Access_Type,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-secondary-stack-size}@anchor{14e} +@anchor{gnat_rm/implementation_defined_aspects aspect-secondary-stack-size}@anchor{152} @section Aspect Secondary_Stack_Size @geindex Secondary_Stack_Size -This aspect is equivalent to @ref{df,,pragma Secondary_Stack_Size}. +This aspect is equivalent to @ref{e1,,pragma Secondary_Stack_Size}. @node Aspect Scalar_Storage_Order,Aspect Shared,Aspect Secondary_Stack_Size,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-scalar-storage-order}@anchor{14f} +@anchor{gnat_rm/implementation_defined_aspects aspect-scalar-storage-order}@anchor{153} @section Aspect Scalar_Storage_Order @geindex Scalar_Storage_Order -This aspect is equivalent to a @ref{150,,attribute Scalar_Storage_Order}. +This aspect is equivalent to a @ref{154,,attribute Scalar_Storage_Order}. @node Aspect Shared,Aspect Simple_Storage_Pool,Aspect Scalar_Storage_Order,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-shared}@anchor{151} +@anchor{gnat_rm/implementation_defined_aspects aspect-shared}@anchor{155} @section Aspect Shared @geindex Shared -This boolean aspect is equivalent to @ref{e2,,pragma Shared} +This boolean aspect is equivalent to @ref{e4,,pragma Shared} and is thus a synonym for aspect @code{Atomic}. @node Aspect Simple_Storage_Pool,Aspect Simple_Storage_Pool_Type,Aspect Shared,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-simple-storage-pool}@anchor{152} +@anchor{gnat_rm/implementation_defined_aspects aspect-simple-storage-pool}@anchor{156} @section Aspect Simple_Storage_Pool @geindex Simple_Storage_Pool -This aspect is equivalent to @ref{e7,,attribute Simple_Storage_Pool}. +This aspect is equivalent to @ref{e9,,attribute Simple_Storage_Pool}. @node Aspect Simple_Storage_Pool_Type,Aspect SPARK_Mode,Aspect Simple_Storage_Pool,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-simple-storage-pool-type}@anchor{153} +@anchor{gnat_rm/implementation_defined_aspects aspect-simple-storage-pool-type}@anchor{157} @section Aspect Simple_Storage_Pool_Type @geindex Simple_Storage_Pool_Type -This boolean aspect is equivalent to @ref{e5,,pragma Simple_Storage_Pool_Type}. +This boolean aspect is equivalent to @ref{e7,,pragma Simple_Storage_Pool_Type}. @node Aspect SPARK_Mode,Aspect Suppress_Debug_Info,Aspect Simple_Storage_Pool_Type,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-spark-mode}@anchor{154} +@anchor{gnat_rm/implementation_defined_aspects aspect-spark-mode}@anchor{158} @section Aspect SPARK_Mode @geindex SPARK_Mode -This aspect is equivalent to @ref{ed,,pragma SPARK_Mode} and +This aspect is equivalent to @ref{ef,,pragma SPARK_Mode} and may be specified for either or both of the specification and body of a subprogram or package. @node Aspect Suppress_Debug_Info,Aspect Suppress_Initialization,Aspect SPARK_Mode,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-suppress-debug-info}@anchor{155} +@anchor{gnat_rm/implementation_defined_aspects aspect-suppress-debug-info}@anchor{159} @section Aspect Suppress_Debug_Info @geindex Suppress_Debug_Info -This boolean aspect is equivalent to @ref{f5,,pragma Suppress_Debug_Info}. +This boolean aspect is equivalent to @ref{f7,,pragma Suppress_Debug_Info}. @node Aspect Suppress_Initialization,Aspect Test_Case,Aspect Suppress_Debug_Info,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-suppress-initialization}@anchor{156} +@anchor{gnat_rm/implementation_defined_aspects aspect-suppress-initialization}@anchor{15a} @section Aspect Suppress_Initialization @geindex Suppress_Initialization -This boolean aspect is equivalent to @ref{f9,,pragma Suppress_Initialization}. +This boolean aspect is equivalent to @ref{fb,,pragma Suppress_Initialization}. @node Aspect Test_Case,Aspect Thread_Local_Storage,Aspect Suppress_Initialization,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-test-case}@anchor{157} +@anchor{gnat_rm/implementation_defined_aspects aspect-test-case}@anchor{15b} @section Aspect Test_Case @geindex Test_Case -This aspect is equivalent to @ref{fc,,pragma Test_Case}. +This aspect is equivalent to @ref{fe,,pragma Test_Case}. @node Aspect Thread_Local_Storage,Aspect Universal_Aliasing,Aspect Test_Case,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-thread-local-storage}@anchor{158} +@anchor{gnat_rm/implementation_defined_aspects aspect-thread-local-storage}@anchor{15c} @section Aspect Thread_Local_Storage @geindex Thread_Local_Storage -This boolean aspect is equivalent to @ref{fe,,pragma Thread_Local_Storage}. +This boolean aspect is equivalent to @ref{100,,pragma Thread_Local_Storage}. @node Aspect Universal_Aliasing,Aspect Universal_Data,Aspect Thread_Local_Storage,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-universal-aliasing}@anchor{159} +@anchor{gnat_rm/implementation_defined_aspects aspect-universal-aliasing}@anchor{15d} @section Aspect Universal_Aliasing @geindex Universal_Aliasing -This boolean aspect is equivalent to @ref{109,,pragma Universal_Aliasing}. +This boolean aspect is equivalent to @ref{10a,,pragma Universal_Aliasing}. @node Aspect Universal_Data,Aspect Unmodified,Aspect Universal_Aliasing,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-universal-data}@anchor{15a} +@anchor{gnat_rm/implementation_defined_aspects aspect-universal-data}@anchor{15e} @section Aspect Universal_Data @geindex Universal_Data -This aspect is equivalent to @ref{10a,,pragma Universal_Data}. +This aspect is equivalent to @ref{10c,,pragma Universal_Data}. @node Aspect Unmodified,Aspect Unreferenced,Aspect Universal_Data,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-unmodified}@anchor{15b} +@anchor{gnat_rm/implementation_defined_aspects aspect-unmodified}@anchor{15f} @section Aspect Unmodified @geindex Unmodified -This boolean aspect is equivalent to @ref{10c,,pragma Unmodified}. +This boolean aspect is equivalent to @ref{10f,,pragma Unmodified}. @node Aspect Unreferenced,Aspect Unreferenced_Objects,Aspect Unmodified,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-unreferenced}@anchor{15c} +@anchor{gnat_rm/implementation_defined_aspects aspect-unreferenced}@anchor{160} @section Aspect Unreferenced @geindex Unreferenced -This boolean aspect is equivalent to @ref{10e,,pragma Unreferenced}. Note that +This boolean aspect is equivalent to @ref{110,,pragma Unreferenced}. Note that in the case of formal parameters, it is not permitted to have aspects for a formal parameter, so in this case the pragma form must be used. @node Aspect Unreferenced_Objects,Aspect Value_Size,Aspect Unreferenced,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-unreferenced-objects}@anchor{15d} +@anchor{gnat_rm/implementation_defined_aspects aspect-unreferenced-objects}@anchor{161} @section Aspect Unreferenced_Objects @geindex Unreferenced_Objects -This boolean aspect is equivalent to @ref{110,,pragma Unreferenced_Objects}. +This boolean aspect is equivalent to @ref{112,,pragma Unreferenced_Objects}. @node Aspect Value_Size,Aspect Volatile_Full_Access,Aspect Unreferenced_Objects,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-value-size}@anchor{15e} +@anchor{gnat_rm/implementation_defined_aspects aspect-value-size}@anchor{162} @section Aspect Value_Size @geindex Value_Size -This aspect is equivalent to @ref{15f,,attribute Value_Size}. +This aspect is equivalent to @ref{163,,attribute Value_Size}. @node Aspect Volatile_Full_Access,Aspect Volatile_Function,Aspect Value_Size,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-volatile-full-access}@anchor{160} +@anchor{gnat_rm/implementation_defined_aspects aspect-volatile-full-access}@anchor{164} @section Aspect Volatile_Full_Access @geindex Volatile_Full_Access -This boolean aspect is equivalent to @ref{119,,pragma Volatile_Full_Access}. +This boolean aspect is equivalent to @ref{11d,,pragma Volatile_Full_Access}. @node Aspect Volatile_Function,Aspect Warnings,Aspect Volatile_Full_Access,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-volatile-function}@anchor{161} +@anchor{gnat_rm/implementation_defined_aspects aspect-volatile-function}@anchor{165} @section Aspect Volatile_Function @geindex Volatile_Function -This boolean aspect is equivalent to @ref{11c,,pragma Volatile_Function}. +This boolean aspect is equivalent to @ref{11f,,pragma Volatile_Function}. @node Aspect Warnings,,Aspect Volatile_Function,Implementation Defined Aspects -@anchor{gnat_rm/implementation_defined_aspects aspect-warnings}@anchor{162} +@anchor{gnat_rm/implementation_defined_aspects aspect-warnings}@anchor{166} @section Aspect Warnings @geindex Warnings -This aspect is equivalent to the two argument form of @ref{11e,,pragma Warnings}, +This aspect is equivalent to the two argument form of @ref{121,,pragma Warnings}, where the first argument is @code{ON} or @code{OFF} and the second argument is the entity. @node Implementation Defined Attributes,Standard and Implementation Defined Restrictions,Implementation Defined Aspects,Top -@anchor{gnat_rm/implementation_defined_attributes doc}@anchor{163}@anchor{gnat_rm/implementation_defined_attributes implementation-defined-attributes}@anchor{8}@anchor{gnat_rm/implementation_defined_attributes id1}@anchor{164} +@anchor{gnat_rm/implementation_defined_attributes doc}@anchor{167}@anchor{gnat_rm/implementation_defined_attributes implementation-defined-attributes}@anchor{8}@anchor{gnat_rm/implementation_defined_attributes id1}@anchor{168} @chapter Implementation Defined Attributes @@ -10169,7 +10196,7 @@ consideration, you should minimize the use of these attributes. @end menu @node Attribute Abort_Signal,Attribute Address_Size,,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-abort-signal}@anchor{165} +@anchor{gnat_rm/implementation_defined_attributes attribute-abort-signal}@anchor{169} @section Attribute Abort_Signal @@ -10183,7 +10210,7 @@ completely outside the normal semantics of Ada, for a user program to intercept the abort exception). @node Attribute Address_Size,Attribute Asm_Input,Attribute Abort_Signal,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-address-size}@anchor{166} +@anchor{gnat_rm/implementation_defined_attributes attribute-address-size}@anchor{16a} @section Attribute Address_Size @@ -10199,7 +10226,7 @@ reference to System.Address'Size is nonstatic because Address is a private type. @node Attribute Asm_Input,Attribute Asm_Output,Attribute Address_Size,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-asm-input}@anchor{167} +@anchor{gnat_rm/implementation_defined_attributes attribute-asm-input}@anchor{16b} @section Attribute Asm_Input @@ -10213,10 +10240,10 @@ to be a static expression, and is the constraint for the parameter, value to be used as the input argument. The possible values for the constant are the same as those used in the RTL, and are dependent on the configuration file used to built the GCC back end. -@ref{168,,Machine Code Insertions} +@ref{16c,,Machine Code Insertions} @node Attribute Asm_Output,Attribute Atomic_Always_Lock_Free,Attribute Asm_Input,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-asm-output}@anchor{169} +@anchor{gnat_rm/implementation_defined_attributes attribute-asm-output}@anchor{16d} @section Attribute Asm_Output @@ -10232,10 +10259,10 @@ result. The possible values for constraint are the same as those used in the RTL, and are dependent on the configuration file used to build the GCC back end. If there are no output operands, then this argument may either be omitted, or explicitly given as @code{No_Output_Operands}. -@ref{168,,Machine Code Insertions} +@ref{16c,,Machine Code Insertions} @node Attribute Atomic_Always_Lock_Free,Attribute Bit,Attribute Asm_Output,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-atomic-always-lock-free}@anchor{16a} +@anchor{gnat_rm/implementation_defined_attributes attribute-atomic-always-lock-free}@anchor{16e} @section Attribute Atomic_Always_Lock_Free @@ -10247,7 +10274,7 @@ and False otherwise. The result indicate whether atomic operations are supported by the target for the given type. @node Attribute Bit,Attribute Bit_Position,Attribute Atomic_Always_Lock_Free,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-bit}@anchor{16b} +@anchor{gnat_rm/implementation_defined_attributes attribute-bit}@anchor{16f} @section Attribute Bit @@ -10278,7 +10305,7 @@ This attribute is designed to be compatible with the DEC Ada 83 definition and implementation of the @code{Bit} attribute. @node Attribute Bit_Position,Attribute Code_Address,Attribute Bit,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-bit-position}@anchor{16c} +@anchor{gnat_rm/implementation_defined_attributes attribute-bit-position}@anchor{170} @section Attribute Bit_Position @@ -10293,7 +10320,7 @@ type @emph{universal_integer}. The value depends only on the field the containing record @code{R}. @node Attribute Code_Address,Attribute Compiler_Version,Attribute Bit_Position,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-code-address}@anchor{16d} +@anchor{gnat_rm/implementation_defined_attributes attribute-code-address}@anchor{171} @section Attribute Code_Address @@ -10336,7 +10363,7 @@ the same value as is returned by the corresponding @code{'Address} attribute. @node Attribute Compiler_Version,Attribute Constrained,Attribute Code_Address,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-compiler-version}@anchor{16e} +@anchor{gnat_rm/implementation_defined_attributes attribute-compiler-version}@anchor{172} @section Attribute Compiler_Version @@ -10347,7 +10374,7 @@ prefix) yields a static string identifying the version of the compiler being used to compile the unit containing the attribute reference. @node Attribute Constrained,Attribute Default_Bit_Order,Attribute Compiler_Version,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-constrained}@anchor{16f} +@anchor{gnat_rm/implementation_defined_attributes attribute-constrained}@anchor{173} @section Attribute Constrained @@ -10362,7 +10389,7 @@ record type without discriminants is always @code{True}. This usage is compatible with older Ada compilers, including notably DEC Ada. @node Attribute Default_Bit_Order,Attribute Default_Scalar_Storage_Order,Attribute Constrained,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-default-bit-order}@anchor{170} +@anchor{gnat_rm/implementation_defined_attributes attribute-default-bit-order}@anchor{174} @section Attribute Default_Bit_Order @@ -10379,7 +10406,7 @@ as a @code{Pos} value (0 for @code{High_Order_First}, 1 for @code{Default_Bit_Order} in package @code{System}. @node Attribute Default_Scalar_Storage_Order,Attribute Deref,Attribute Default_Bit_Order,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-default-scalar-storage-order}@anchor{171} +@anchor{gnat_rm/implementation_defined_attributes attribute-default-scalar-storage-order}@anchor{175} @section Attribute Default_Scalar_Storage_Order @@ -10396,7 +10423,7 @@ equal to @code{Default_Bit_Order} if unspecified) as a @code{System.Bit_Order} value. This is a static attribute. @node Attribute Deref,Attribute Descriptor_Size,Attribute Default_Scalar_Storage_Order,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-deref}@anchor{172} +@anchor{gnat_rm/implementation_defined_attributes attribute-deref}@anchor{176} @section Attribute Deref @@ -10409,7 +10436,7 @@ a named access-to-@cite{typ} type, except that it yields a variable, so it can b used on the left side of an assignment. @node Attribute Descriptor_Size,Attribute Elaborated,Attribute Deref,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-descriptor-size}@anchor{173} +@anchor{gnat_rm/implementation_defined_attributes attribute-descriptor-size}@anchor{177} @section Attribute Descriptor_Size @@ -10436,7 +10463,7 @@ In the example above, the descriptor contains two values of type a size of 31 bits and an alignment of 4, the descriptor size is @code{2 * Positive'Size + 2} or 64 bits. @node Attribute Elaborated,Attribute Elab_Body,Attribute Descriptor_Size,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-elaborated}@anchor{174} +@anchor{gnat_rm/implementation_defined_attributes attribute-elaborated}@anchor{178} @section Attribute Elaborated @@ -10451,7 +10478,7 @@ units has been completed. An exception is for units which need no elaboration, the value is always False for such units. @node Attribute Elab_Body,Attribute Elab_Spec,Attribute Elaborated,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-elab-body}@anchor{175} +@anchor{gnat_rm/implementation_defined_attributes attribute-elab-body}@anchor{179} @section Attribute Elab_Body @@ -10467,7 +10494,7 @@ e.g., if it is necessary to do selective re-elaboration to fix some error. @node Attribute Elab_Spec,Attribute Elab_Subp_Body,Attribute Elab_Body,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-elab-spec}@anchor{176} +@anchor{gnat_rm/implementation_defined_attributes attribute-elab-spec}@anchor{17a} @section Attribute Elab_Spec @@ -10483,7 +10510,7 @@ Ada code, e.g., if it is necessary to do selective re-elaboration to fix some error. @node Attribute Elab_Subp_Body,Attribute Emax,Attribute Elab_Spec,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-elab-subp-body}@anchor{177} +@anchor{gnat_rm/implementation_defined_attributes attribute-elab-subp-body}@anchor{17b} @section Attribute Elab_Subp_Body @@ -10497,7 +10524,7 @@ elaboration procedure by the binder in CodePeer mode only and is unrecognized otherwise. @node Attribute Emax,Attribute Enabled,Attribute Elab_Subp_Body,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-emax}@anchor{178} +@anchor{gnat_rm/implementation_defined_attributes attribute-emax}@anchor{17c} @section Attribute Emax @@ -10510,7 +10537,7 @@ the Ada 83 reference manual for an exact description of the semantics of this attribute. @node Attribute Enabled,Attribute Enum_Rep,Attribute Emax,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-enabled}@anchor{179} +@anchor{gnat_rm/implementation_defined_attributes attribute-enabled}@anchor{17d} @section Attribute Enabled @@ -10534,7 +10561,7 @@ a @code{pragma Suppress} or @code{pragma Unsuppress} before instantiating the package or subprogram, controlling whether the check will be present. @node Attribute Enum_Rep,Attribute Enum_Val,Attribute Enabled,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-enum-rep}@anchor{17a} +@anchor{gnat_rm/implementation_defined_attributes attribute-enum-rep}@anchor{17e} @section Attribute Enum_Rep @@ -10571,7 +10598,7 @@ integer calculation is done at run time, then the call to @code{Enum_Rep} may raise @code{Constraint_Error}. @node Attribute Enum_Val,Attribute Epsilon,Attribute Enum_Rep,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-enum-val}@anchor{17b} +@anchor{gnat_rm/implementation_defined_attributes attribute-enum-val}@anchor{17f} @section Attribute Enum_Val @@ -10594,7 +10621,7 @@ absence of an enumeration representation clause. This is a static attribute (i.e., the result is static if the argument is static). @node Attribute Epsilon,Attribute Fast_Math,Attribute Enum_Val,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-epsilon}@anchor{17c} +@anchor{gnat_rm/implementation_defined_attributes attribute-epsilon}@anchor{180} @section Attribute Epsilon @@ -10607,7 +10634,7 @@ the Ada 83 reference manual for an exact description of the semantics of this attribute. @node Attribute Fast_Math,Attribute Finalization_Size,Attribute Epsilon,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-fast-math}@anchor{17d} +@anchor{gnat_rm/implementation_defined_attributes attribute-fast-math}@anchor{181} @section Attribute Fast_Math @@ -10618,7 +10645,7 @@ prefix) yields a static Boolean value that is True if pragma @code{Fast_Math} is active, and False otherwise. @node Attribute Finalization_Size,Attribute Fixed_Value,Attribute Fast_Math,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-finalization-size}@anchor{17e} +@anchor{gnat_rm/implementation_defined_attributes attribute-finalization-size}@anchor{182} @section Attribute Finalization_Size @@ -10636,7 +10663,7 @@ class-wide type whose tag denotes a type with no controlled parts. Note that only heap-allocated objects contain finalization data. @node Attribute Fixed_Value,Attribute From_Any,Attribute Finalization_Size,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-fixed-value}@anchor{17f} +@anchor{gnat_rm/implementation_defined_attributes attribute-fixed-value}@anchor{183} @section Attribute Fixed_Value @@ -10663,7 +10690,7 @@ This attribute is primarily intended for use in implementation of the input-output functions for fixed-point values. @node Attribute From_Any,Attribute Has_Access_Values,Attribute Fixed_Value,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-from-any}@anchor{180} +@anchor{gnat_rm/implementation_defined_attributes attribute-from-any}@anchor{184} @section Attribute From_Any @@ -10673,7 +10700,7 @@ This internal attribute is used for the generation of remote subprogram stubs in the context of the Distributed Systems Annex. @node Attribute Has_Access_Values,Attribute Has_Discriminants,Attribute From_Any,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-has-access-values}@anchor{181} +@anchor{gnat_rm/implementation_defined_attributes attribute-has-access-values}@anchor{185} @section Attribute Has_Access_Values @@ -10691,7 +10718,7 @@ definitions. If the attribute is applied to a generic private type, it indicates whether or not the corresponding actual type has access values. @node Attribute Has_Discriminants,Attribute Img,Attribute Has_Access_Values,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-has-discriminants}@anchor{182} +@anchor{gnat_rm/implementation_defined_attributes attribute-has-discriminants}@anchor{186} @section Attribute Has_Discriminants @@ -10707,7 +10734,7 @@ definitions. If the attribute is applied to a generic private type, it indicates whether or not the corresponding actual type has discriminants. @node Attribute Img,Attribute Integer_Value,Attribute Has_Discriminants,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-img}@anchor{183} +@anchor{gnat_rm/implementation_defined_attributes attribute-img}@anchor{187} @section Attribute Img @@ -10737,7 +10764,7 @@ that returns the appropriate string when called. This means that in an instantiation as a function parameter. @node Attribute Integer_Value,Attribute Invalid_Value,Attribute Img,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-integer-value}@anchor{184} +@anchor{gnat_rm/implementation_defined_attributes attribute-integer-value}@anchor{188} @section Attribute Integer_Value @@ -10765,7 +10792,7 @@ This attribute is primarily intended for use in implementation of the standard input-output functions for fixed-point values. @node Attribute Invalid_Value,Attribute Iterable,Attribute Integer_Value,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-invalid-value}@anchor{185} +@anchor{gnat_rm/implementation_defined_attributes attribute-invalid-value}@anchor{189} @section Attribute Invalid_Value @@ -10779,7 +10806,7 @@ including the ability to modify the value with the binder -Sxx flag and relevant environment variables at run time. @node Attribute Iterable,Attribute Large,Attribute Invalid_Value,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-iterable}@anchor{186} +@anchor{gnat_rm/implementation_defined_attributes attribute-iterable}@anchor{18a} @section Attribute Iterable @@ -10788,7 +10815,7 @@ relevant environment variables at run time. Equivalent to Aspect Iterable. @node Attribute Large,Attribute Library_Level,Attribute Iterable,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-large}@anchor{187} +@anchor{gnat_rm/implementation_defined_attributes attribute-large}@anchor{18b} @section Attribute Large @@ -10801,7 +10828,7 @@ the Ada 83 reference manual for an exact description of the semantics of this attribute. @node Attribute Library_Level,Attribute Lock_Free,Attribute Large,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-library-level}@anchor{188} +@anchor{gnat_rm/implementation_defined_attributes attribute-library-level}@anchor{18c} @section Attribute Library_Level @@ -10827,7 +10854,7 @@ end Gen; @end example @node Attribute Lock_Free,Attribute Loop_Entry,Attribute Library_Level,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-lock-free}@anchor{189} +@anchor{gnat_rm/implementation_defined_attributes attribute-lock-free}@anchor{18d} @section Attribute Lock_Free @@ -10837,7 +10864,7 @@ end Gen; pragma @code{Lock_Free} applies to P. @node Attribute Loop_Entry,Attribute Machine_Size,Attribute Lock_Free,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-loop-entry}@anchor{18a} +@anchor{gnat_rm/implementation_defined_attributes attribute-loop-entry}@anchor{18e} @section Attribute Loop_Entry @@ -10867,7 +10894,7 @@ entry. This copy is not performed if the loop is not entered, or if the corresponding pragmas are ignored or disabled. @node Attribute Machine_Size,Attribute Mantissa,Attribute Loop_Entry,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-machine-size}@anchor{18b} +@anchor{gnat_rm/implementation_defined_attributes attribute-machine-size}@anchor{18f} @section Attribute Machine_Size @@ -10877,7 +10904,7 @@ This attribute is identical to the @code{Object_Size} attribute. It is provided for compatibility with the DEC Ada 83 attribute of this name. @node Attribute Mantissa,Attribute Maximum_Alignment,Attribute Machine_Size,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-mantissa}@anchor{18c} +@anchor{gnat_rm/implementation_defined_attributes attribute-mantissa}@anchor{190} @section Attribute Mantissa @@ -10890,7 +10917,7 @@ the Ada 83 reference manual for an exact description of the semantics of this attribute. @node Attribute Maximum_Alignment,Attribute Mechanism_Code,Attribute Mantissa,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-maximum-alignment}@anchor{18d}@anchor{gnat_rm/implementation_defined_attributes id2}@anchor{18e} +@anchor{gnat_rm/implementation_defined_attributes attribute-maximum-alignment}@anchor{191}@anchor{gnat_rm/implementation_defined_attributes id2}@anchor{192} @section Attribute Maximum_Alignment @@ -10906,7 +10933,7 @@ for an object, guaranteeing that it is properly aligned in all cases. @node Attribute Mechanism_Code,Attribute Null_Parameter,Attribute Maximum_Alignment,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-mechanism-code}@anchor{18f} +@anchor{gnat_rm/implementation_defined_attributes attribute-mechanism-code}@anchor{193} @section Attribute Mechanism_Code @@ -10937,7 +10964,7 @@ by reference @end table @node Attribute Null_Parameter,Attribute Object_Size,Attribute Mechanism_Code,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-null-parameter}@anchor{190} +@anchor{gnat_rm/implementation_defined_attributes attribute-null-parameter}@anchor{194} @section Attribute Null_Parameter @@ -10962,7 +10989,7 @@ There is no way of indicating this without the @code{Null_Parameter} attribute. @node Attribute Object_Size,Attribute Old,Attribute Null_Parameter,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-object-size}@anchor{143}@anchor{gnat_rm/implementation_defined_attributes id3}@anchor{191} +@anchor{gnat_rm/implementation_defined_attributes attribute-object-size}@anchor{147}@anchor{gnat_rm/implementation_defined_attributes id3}@anchor{195} @section Attribute Object_Size @@ -11032,7 +11059,7 @@ Similar additional checks are performed in other contexts requiring statically matching subtypes. @node Attribute Old,Attribute Passed_By_Reference,Attribute Object_Size,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-old}@anchor{192} +@anchor{gnat_rm/implementation_defined_attributes attribute-old}@anchor{196} @section Attribute Old @@ -11047,7 +11074,7 @@ definition are allowed under control of implementation defined pragma @code{Unevaluated_Use_Of_Old}. @node Attribute Passed_By_Reference,Attribute Pool_Address,Attribute Old,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-passed-by-reference}@anchor{193} +@anchor{gnat_rm/implementation_defined_attributes attribute-passed-by-reference}@anchor{197} @section Attribute Passed_By_Reference @@ -11063,7 +11090,7 @@ passed by copy in calls. For scalar types, the result is always @code{False} and is static. For non-scalar types, the result is nonstatic. @node Attribute Pool_Address,Attribute Range_Length,Attribute Passed_By_Reference,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-pool-address}@anchor{194} +@anchor{gnat_rm/implementation_defined_attributes attribute-pool-address}@anchor{198} @section Attribute Pool_Address @@ -11088,7 +11115,7 @@ For an object created by @code{new}, @code{Ptr.all'Pool_Address} is what is passed to @code{Allocate} and returned from @code{Deallocate}. @node Attribute Range_Length,Attribute Restriction_Set,Attribute Pool_Address,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-range-length}@anchor{195} +@anchor{gnat_rm/implementation_defined_attributes attribute-range-length}@anchor{199} @section Attribute Range_Length @@ -11101,7 +11128,7 @@ applied to the index subtype of a one dimensional array always gives the same result as @code{Length} applied to the array itself. @node Attribute Restriction_Set,Attribute Result,Attribute Range_Length,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-restriction-set}@anchor{196} +@anchor{gnat_rm/implementation_defined_attributes attribute-restriction-set}@anchor{19a} @section Attribute Restriction_Set @@ -11171,7 +11198,7 @@ Restrictions pragma, they are not analyzed semantically, so they do not have a type. @node Attribute Result,Attribute Safe_Emax,Attribute Restriction_Set,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-result}@anchor{197} +@anchor{gnat_rm/implementation_defined_attributes attribute-result}@anchor{19b} @section Attribute Result @@ -11184,7 +11211,7 @@ For a further discussion of the use of this attribute and examples of its use, see the description of pragma Postcondition. @node Attribute Safe_Emax,Attribute Safe_Large,Attribute Result,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-safe-emax}@anchor{198} +@anchor{gnat_rm/implementation_defined_attributes attribute-safe-emax}@anchor{19c} @section Attribute Safe_Emax @@ -11197,7 +11224,7 @@ the Ada 83 reference manual for an exact description of the semantics of this attribute. @node Attribute Safe_Large,Attribute Safe_Small,Attribute Safe_Emax,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-safe-large}@anchor{199} +@anchor{gnat_rm/implementation_defined_attributes attribute-safe-large}@anchor{19d} @section Attribute Safe_Large @@ -11210,7 +11237,7 @@ the Ada 83 reference manual for an exact description of the semantics of this attribute. @node Attribute Safe_Small,Attribute Scalar_Storage_Order,Attribute Safe_Large,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-safe-small}@anchor{19a} +@anchor{gnat_rm/implementation_defined_attributes attribute-safe-small}@anchor{19e} @section Attribute Safe_Small @@ -11223,7 +11250,7 @@ the Ada 83 reference manual for an exact description of the semantics of this attribute. @node Attribute Scalar_Storage_Order,Attribute Simple_Storage_Pool,Attribute Safe_Small,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes id4}@anchor{19b}@anchor{gnat_rm/implementation_defined_attributes attribute-scalar-storage-order}@anchor{150} +@anchor{gnat_rm/implementation_defined_attributes id4}@anchor{19f}@anchor{gnat_rm/implementation_defined_attributes attribute-scalar-storage-order}@anchor{154} @section Attribute Scalar_Storage_Order @@ -11346,7 +11373,7 @@ Note that debuggers may be unable to display the correct value of scalar components of a type for which the opposite storage order is specified. @node Attribute Simple_Storage_Pool,Attribute Small,Attribute Scalar_Storage_Order,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-simple-storage-pool}@anchor{e7}@anchor{gnat_rm/implementation_defined_attributes id5}@anchor{19c} +@anchor{gnat_rm/implementation_defined_attributes attribute-simple-storage-pool}@anchor{e9}@anchor{gnat_rm/implementation_defined_attributes id5}@anchor{1a0} @section Attribute Simple_Storage_Pool @@ -11409,7 +11436,7 @@ as defined in section 13.11.2 of the Ada Reference Manual, except that the term @emph{simple storage pool} is substituted for @emph{storage pool}. @node Attribute Small,Attribute Storage_Unit,Attribute Simple_Storage_Pool,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-small}@anchor{19d} +@anchor{gnat_rm/implementation_defined_attributes attribute-small}@anchor{1a1} @section Attribute Small @@ -11425,7 +11452,7 @@ the Ada 83 reference manual for an exact description of the semantics of this attribute when applied to floating-point types. @node Attribute Storage_Unit,Attribute Stub_Type,Attribute Small,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-storage-unit}@anchor{19e} +@anchor{gnat_rm/implementation_defined_attributes attribute-storage-unit}@anchor{1a2} @section Attribute Storage_Unit @@ -11435,7 +11462,7 @@ this attribute when applied to floating-point types. prefix) provides the same value as @code{System.Storage_Unit}. @node Attribute Stub_Type,Attribute System_Allocator_Alignment,Attribute Storage_Unit,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-stub-type}@anchor{19f} +@anchor{gnat_rm/implementation_defined_attributes attribute-stub-type}@anchor{1a3} @section Attribute Stub_Type @@ -11459,7 +11486,7 @@ unit @code{System.Partition_Interface}. Use of this attribute will create an implicit dependency on this unit. @node Attribute System_Allocator_Alignment,Attribute Target_Name,Attribute Stub_Type,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-system-allocator-alignment}@anchor{1a0} +@anchor{gnat_rm/implementation_defined_attributes attribute-system-allocator-alignment}@anchor{1a4} @section Attribute System_Allocator_Alignment @@ -11476,7 +11503,7 @@ with alignment too large or to enable a realignment circuitry if the alignment request is larger than this value. @node Attribute Target_Name,Attribute To_Address,Attribute System_Allocator_Alignment,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-target-name}@anchor{1a1} +@anchor{gnat_rm/implementation_defined_attributes attribute-target-name}@anchor{1a5} @section Attribute Target_Name @@ -11489,7 +11516,7 @@ standard gcc target name without the terminating slash (for example, GNAT 5.0 on windows yields "i586-pc-mingw32msv"). @node Attribute To_Address,Attribute To_Any,Attribute Target_Name,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-to-address}@anchor{1a2} +@anchor{gnat_rm/implementation_defined_attributes attribute-to-address}@anchor{1a6} @section Attribute To_Address @@ -11512,7 +11539,7 @@ modular manner (e.g., -1 means the same as 16#FFFF_FFFF# on a 32 bits machine). @node Attribute To_Any,Attribute Type_Class,Attribute To_Address,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-to-any}@anchor{1a3} +@anchor{gnat_rm/implementation_defined_attributes attribute-to-any}@anchor{1a7} @section Attribute To_Any @@ -11522,7 +11549,7 @@ This internal attribute is used for the generation of remote subprogram stubs in the context of the Distributed Systems Annex. @node Attribute Type_Class,Attribute Type_Key,Attribute To_Any,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-type-class}@anchor{1a4} +@anchor{gnat_rm/implementation_defined_attributes attribute-type-class}@anchor{1a8} @section Attribute Type_Class @@ -11552,7 +11579,7 @@ applies to all concurrent types. This attribute is designed to be compatible with the DEC Ada 83 attribute of the same name. @node Attribute Type_Key,Attribute TypeCode,Attribute Type_Class,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-type-key}@anchor{1a5} +@anchor{gnat_rm/implementation_defined_attributes attribute-type-key}@anchor{1a9} @section Attribute Type_Key @@ -11564,7 +11591,7 @@ about the type or subtype. This provides improved compatibility with other implementations that support this attribute. @node Attribute TypeCode,Attribute Unconstrained_Array,Attribute Type_Key,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-typecode}@anchor{1a6} +@anchor{gnat_rm/implementation_defined_attributes attribute-typecode}@anchor{1aa} @section Attribute TypeCode @@ -11574,7 +11601,7 @@ This internal attribute is used for the generation of remote subprogram stubs in the context of the Distributed Systems Annex. @node Attribute Unconstrained_Array,Attribute Universal_Literal_String,Attribute TypeCode,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-unconstrained-array}@anchor{1a7} +@anchor{gnat_rm/implementation_defined_attributes attribute-unconstrained-array}@anchor{1ab} @section Attribute Unconstrained_Array @@ -11588,7 +11615,7 @@ still static, and yields the result of applying this test to the generic actual. @node Attribute Universal_Literal_String,Attribute Unrestricted_Access,Attribute Unconstrained_Array,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-universal-literal-string}@anchor{1a8} +@anchor{gnat_rm/implementation_defined_attributes attribute-universal-literal-string}@anchor{1ac} @section Attribute Universal_Literal_String @@ -11616,7 +11643,7 @@ end; @end example @node Attribute Unrestricted_Access,Attribute Update,Attribute Universal_Literal_String,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-unrestricted-access}@anchor{1a9} +@anchor{gnat_rm/implementation_defined_attributes attribute-unrestricted-access}@anchor{1ad} @section Attribute Unrestricted_Access @@ -11803,7 +11830,7 @@ In general this is a risky approach. It may appear to "work" but such uses of of GNAT to another, so are best avoided if possible. @node Attribute Update,Attribute Valid_Scalars,Attribute Unrestricted_Access,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-update}@anchor{1aa} +@anchor{gnat_rm/implementation_defined_attributes attribute-update}@anchor{1ae} @section Attribute Update @@ -11884,7 +11911,7 @@ A := A'Update ((1, 2) => 20, (3, 4) => 30); which changes element (1,2) to 20 and (3,4) to 30. @node Attribute Valid_Scalars,Attribute VADS_Size,Attribute Update,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-valid-scalars}@anchor{1ab} +@anchor{gnat_rm/implementation_defined_attributes attribute-valid-scalars}@anchor{1af} @section Attribute Valid_Scalars @@ -11918,7 +11945,7 @@ write a function with a single use of the attribute, and then call that function from multiple places. @node Attribute VADS_Size,Attribute Value_Size,Attribute Valid_Scalars,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-vads-size}@anchor{1ac} +@anchor{gnat_rm/implementation_defined_attributes attribute-vads-size}@anchor{1b0} @section Attribute VADS_Size @@ -11938,7 +11965,7 @@ gives the result that would be obtained by applying the attribute to the corresponding type. @node Attribute Value_Size,Attribute Wchar_T_Size,Attribute VADS_Size,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes id6}@anchor{1ad}@anchor{gnat_rm/implementation_defined_attributes attribute-value-size}@anchor{15f} +@anchor{gnat_rm/implementation_defined_attributes id6}@anchor{1b1}@anchor{gnat_rm/implementation_defined_attributes attribute-value-size}@anchor{163} @section Attribute Value_Size @@ -11952,7 +11979,7 @@ a value of the given subtype. It is the same as @code{type'Size}, but, unlike @code{Size}, may be set for non-first subtypes. @node Attribute Wchar_T_Size,Attribute Word_Size,Attribute Value_Size,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-wchar-t-size}@anchor{1ae} +@anchor{gnat_rm/implementation_defined_attributes attribute-wchar-t-size}@anchor{1b2} @section Attribute Wchar_T_Size @@ -11964,7 +11991,7 @@ primarily for constructing the definition of this type in package @code{Interfaces.C}. The result is a static constant. @node Attribute Word_Size,,Attribute Wchar_T_Size,Implementation Defined Attributes -@anchor{gnat_rm/implementation_defined_attributes attribute-word-size}@anchor{1af} +@anchor{gnat_rm/implementation_defined_attributes attribute-word-size}@anchor{1b3} @section Attribute Word_Size @@ -11975,7 +12002,7 @@ prefix) provides the value @code{System.Word_Size}. The result is a static constant. @node Standard and Implementation Defined Restrictions,Implementation Advice,Implementation Defined Attributes,Top -@anchor{gnat_rm/standard_and_implementation_defined_restrictions standard-and-implementation-defined-restrictions}@anchor{9}@anchor{gnat_rm/standard_and_implementation_defined_restrictions doc}@anchor{1b0}@anchor{gnat_rm/standard_and_implementation_defined_restrictions id1}@anchor{1b1} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions standard-and-implementation-defined-restrictions}@anchor{9}@anchor{gnat_rm/standard_and_implementation_defined_restrictions doc}@anchor{1b4}@anchor{gnat_rm/standard_and_implementation_defined_restrictions id1}@anchor{1b5} @chapter Standard and Implementation Defined Restrictions @@ -12004,7 +12031,7 @@ language defined or GNAT-specific, are listed in the following. @end menu @node Partition-Wide Restrictions,Program Unit Level Restrictions,,Standard and Implementation Defined Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions partition-wide-restrictions}@anchor{1b2}@anchor{gnat_rm/standard_and_implementation_defined_restrictions id2}@anchor{1b3} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions partition-wide-restrictions}@anchor{1b6}@anchor{gnat_rm/standard_and_implementation_defined_restrictions id2}@anchor{1b7} @section Partition-Wide Restrictions @@ -12093,7 +12120,7 @@ then all compilation units in the partition must obey the restriction). @end menu @node Immediate_Reclamation,Max_Asynchronous_Select_Nesting,,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions immediate-reclamation}@anchor{1b4} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions immediate-reclamation}@anchor{1b8} @subsection Immediate_Reclamation @@ -12105,7 +12132,7 @@ deallocation, any storage reserved at run time for an object is immediately reclaimed when the object no longer exists. @node Max_Asynchronous_Select_Nesting,Max_Entry_Queue_Length,Immediate_Reclamation,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions max-asynchronous-select-nesting}@anchor{1b5} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions max-asynchronous-select-nesting}@anchor{1b9} @subsection Max_Asynchronous_Select_Nesting @@ -12117,7 +12144,7 @@ detected at compile time. Violations of this restriction with values other than zero cause Storage_Error to be raised. @node Max_Entry_Queue_Length,Max_Protected_Entries,Max_Asynchronous_Select_Nesting,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions max-entry-queue-length}@anchor{1b6} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions max-entry-queue-length}@anchor{1ba} @subsection Max_Entry_Queue_Length @@ -12138,7 +12165,7 @@ compatibility purposes (and a warning will be generated for its use if warnings on obsolescent features are activated). @node Max_Protected_Entries,Max_Select_Alternatives,Max_Entry_Queue_Length,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions max-protected-entries}@anchor{1b7} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions max-protected-entries}@anchor{1bb} @subsection Max_Protected_Entries @@ -12149,7 +12176,7 @@ bounds of every entry family of a protected unit shall be static, or shall be defined by a discriminant of a subtype whose corresponding bound is static. @node Max_Select_Alternatives,Max_Storage_At_Blocking,Max_Protected_Entries,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions max-select-alternatives}@anchor{1b8} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions max-select-alternatives}@anchor{1bc} @subsection Max_Select_Alternatives @@ -12158,7 +12185,7 @@ defined by a discriminant of a subtype whose corresponding bound is static. [RM D.7] Specifies the maximum number of alternatives in a selective accept. @node Max_Storage_At_Blocking,Max_Task_Entries,Max_Select_Alternatives,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions max-storage-at-blocking}@anchor{1b9} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions max-storage-at-blocking}@anchor{1bd} @subsection Max_Storage_At_Blocking @@ -12169,7 +12196,7 @@ Storage_Size that can be retained by a blocked task. A violation of this restriction causes Storage_Error to be raised. @node Max_Task_Entries,Max_Tasks,Max_Storage_At_Blocking,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions max-task-entries}@anchor{1ba} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions max-task-entries}@anchor{1be} @subsection Max_Task_Entries @@ -12182,7 +12209,7 @@ defined by a discriminant of a subtype whose corresponding bound is static. @node Max_Tasks,No_Abort_Statements,Max_Task_Entries,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions max-tasks}@anchor{1bb} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions max-tasks}@anchor{1bf} @subsection Max_Tasks @@ -12195,7 +12222,7 @@ time. Violations of this restriction with values other than zero cause Storage_Error to be raised. @node No_Abort_Statements,No_Access_Parameter_Allocators,Max_Tasks,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-abort-statements}@anchor{1bc} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-abort-statements}@anchor{1c0} @subsection No_Abort_Statements @@ -12205,7 +12232,7 @@ Storage_Error to be raised. no calls to Task_Identification.Abort_Task. @node No_Access_Parameter_Allocators,No_Access_Subprograms,No_Abort_Statements,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-access-parameter-allocators}@anchor{1bd} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-access-parameter-allocators}@anchor{1c1} @subsection No_Access_Parameter_Allocators @@ -12216,7 +12243,7 @@ occurrences of an allocator as the actual parameter to an access parameter. @node No_Access_Subprograms,No_Allocators,No_Access_Parameter_Allocators,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-access-subprograms}@anchor{1be} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-access-subprograms}@anchor{1c2} @subsection No_Access_Subprograms @@ -12226,7 +12253,7 @@ parameter. declarations of access-to-subprogram types. @node No_Allocators,No_Anonymous_Allocators,No_Access_Subprograms,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-allocators}@anchor{1bf} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-allocators}@anchor{1c3} @subsection No_Allocators @@ -12236,7 +12263,7 @@ declarations of access-to-subprogram types. occurrences of an allocator. @node No_Anonymous_Allocators,No_Asynchronous_Control,No_Allocators,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-anonymous-allocators}@anchor{1c0} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-anonymous-allocators}@anchor{1c4} @subsection No_Anonymous_Allocators @@ -12246,7 +12273,7 @@ occurrences of an allocator. occurrences of an allocator of anonymous access type. @node No_Asynchronous_Control,No_Calendar,No_Anonymous_Allocators,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-asynchronous-control}@anchor{1c1} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-asynchronous-control}@anchor{1c5} @subsection No_Asynchronous_Control @@ -12256,7 +12283,7 @@ occurrences of an allocator of anonymous access type. dependences on the predefined package Asynchronous_Task_Control. @node No_Calendar,No_Coextensions,No_Asynchronous_Control,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-calendar}@anchor{1c2} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-calendar}@anchor{1c6} @subsection No_Calendar @@ -12266,7 +12293,7 @@ dependences on the predefined package Asynchronous_Task_Control. dependences on package Calendar. @node No_Coextensions,No_Default_Initialization,No_Calendar,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-coextensions}@anchor{1c3} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-coextensions}@anchor{1c7} @subsection No_Coextensions @@ -12276,7 +12303,7 @@ dependences on package Calendar. coextensions. See 3.10.2. @node No_Default_Initialization,No_Delay,No_Coextensions,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-default-initialization}@anchor{1c4} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-default-initialization}@anchor{1c8} @subsection No_Default_Initialization @@ -12293,7 +12320,7 @@ is to prohibit all cases of variables declared without a specific initializer (including the case of OUT scalar parameters). @node No_Delay,No_Dependence,No_Default_Initialization,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-delay}@anchor{1c5} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-delay}@anchor{1c9} @subsection No_Delay @@ -12303,7 +12330,7 @@ initializer (including the case of OUT scalar parameters). delay statements and no semantic dependences on package Calendar. @node No_Dependence,No_Direct_Boolean_Operators,No_Delay,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-dependence}@anchor{1c6} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-dependence}@anchor{1ca} @subsection No_Dependence @@ -12313,7 +12340,7 @@ delay statements and no semantic dependences on package Calendar. dependences on a library unit. @node No_Direct_Boolean_Operators,No_Dispatch,No_Dependence,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-direct-boolean-operators}@anchor{1c7} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-direct-boolean-operators}@anchor{1cb} @subsection No_Direct_Boolean_Operators @@ -12326,7 +12353,7 @@ protocol requires the use of short-circuit (and then, or else) forms for all composite boolean operations. @node No_Dispatch,No_Dispatching_Calls,No_Direct_Boolean_Operators,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-dispatch}@anchor{1c8} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-dispatch}@anchor{1cc} @subsection No_Dispatch @@ -12336,7 +12363,7 @@ composite boolean operations. occurrences of @code{T'Class}, for any (tagged) subtype @code{T}. @node No_Dispatching_Calls,No_Dynamic_Attachment,No_Dispatch,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-dispatching-calls}@anchor{1c9} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-dispatching-calls}@anchor{1cd} @subsection No_Dispatching_Calls @@ -12397,7 +12424,7 @@ end Example; @end example @node No_Dynamic_Attachment,No_Dynamic_Priorities,No_Dispatching_Calls,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-dynamic-attachment}@anchor{1ca} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-dynamic-attachment}@anchor{1ce} @subsection No_Dynamic_Attachment @@ -12416,7 +12443,7 @@ compatibility purposes (and a warning will be generated for its use if warnings on obsolescent features are activated). @node No_Dynamic_Priorities,No_Entry_Calls_In_Elaboration_Code,No_Dynamic_Attachment,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-dynamic-priorities}@anchor{1cb} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-dynamic-priorities}@anchor{1cf} @subsection No_Dynamic_Priorities @@ -12425,7 +12452,7 @@ warnings on obsolescent features are activated). [RM D.7] There are no semantic dependencies on the package Dynamic_Priorities. @node No_Entry_Calls_In_Elaboration_Code,No_Enumeration_Maps,No_Dynamic_Priorities,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-entry-calls-in-elaboration-code}@anchor{1cc} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-entry-calls-in-elaboration-code}@anchor{1d0} @subsection No_Entry_Calls_In_Elaboration_Code @@ -12437,7 +12464,7 @@ restriction, the compiler can assume that no code past an accept statement in a task can be executed at elaboration time. @node No_Enumeration_Maps,No_Exception_Handlers,No_Entry_Calls_In_Elaboration_Code,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-enumeration-maps}@anchor{1cd} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-enumeration-maps}@anchor{1d1} @subsection No_Enumeration_Maps @@ -12448,7 +12475,7 @@ enumeration maps are used (that is Image and Value attributes applied to enumeration types). @node No_Exception_Handlers,No_Exception_Propagation,No_Enumeration_Maps,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-exception-handlers}@anchor{1ce} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-exception-handlers}@anchor{1d2} @subsection No_Exception_Handlers @@ -12473,7 +12500,7 @@ statement generated by the compiler). The Line parameter when nonzero represents the line number in the source program where the raise occurs. @node No_Exception_Propagation,No_Exception_Registration,No_Exception_Handlers,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-exception-propagation}@anchor{1cf} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-exception-propagation}@anchor{1d3} @subsection No_Exception_Propagation @@ -12490,7 +12517,7 @@ the package GNAT.Current_Exception is not permitted, and reraise statements (raise with no operand) are not permitted. @node No_Exception_Registration,No_Exceptions,No_Exception_Propagation,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-exception-registration}@anchor{1d0} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-exception-registration}@anchor{1d4} @subsection No_Exception_Registration @@ -12504,7 +12531,7 @@ code is simplified by omitting the otherwise-required global registration of exceptions when they are declared. @node No_Exceptions,No_Finalization,No_Exception_Registration,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-exceptions}@anchor{1d1} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-exceptions}@anchor{1d5} @subsection No_Exceptions @@ -12515,7 +12542,7 @@ raise statements and no exception handlers and also suppresses the generation of language-defined run-time checks. @node No_Finalization,No_Fixed_Point,No_Exceptions,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-finalization}@anchor{1d2} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-finalization}@anchor{1d6} @subsection No_Finalization @@ -12556,7 +12583,7 @@ object or a nested component, either declared on the stack or on the heap. The deallocation of a controlled object no longer finalizes its contents. @node No_Fixed_Point,No_Floating_Point,No_Finalization,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-fixed-point}@anchor{1d3} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-fixed-point}@anchor{1d7} @subsection No_Fixed_Point @@ -12566,7 +12593,7 @@ deallocation of a controlled object no longer finalizes its contents. occurrences of fixed point types and operations. @node No_Floating_Point,No_Implicit_Conditionals,No_Fixed_Point,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-floating-point}@anchor{1d4} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-floating-point}@anchor{1d8} @subsection No_Floating_Point @@ -12576,7 +12603,7 @@ occurrences of fixed point types and operations. occurrences of floating point types and operations. @node No_Implicit_Conditionals,No_Implicit_Dynamic_Code,No_Floating_Point,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implicit-conditionals}@anchor{1d5} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implicit-conditionals}@anchor{1d9} @subsection No_Implicit_Conditionals @@ -12592,7 +12619,7 @@ normal manner. Constructs generating implicit conditionals include comparisons of composite objects and the Max/Min attributes. @node No_Implicit_Dynamic_Code,No_Implicit_Heap_Allocations,No_Implicit_Conditionals,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implicit-dynamic-code}@anchor{1d6} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implicit-dynamic-code}@anchor{1da} @subsection No_Implicit_Dynamic_Code @@ -12622,7 +12649,7 @@ foreign-language convention; primitive operations of nested tagged types. @node No_Implicit_Heap_Allocations,No_Implicit_Protected_Object_Allocations,No_Implicit_Dynamic_Code,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implicit-heap-allocations}@anchor{1d7} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implicit-heap-allocations}@anchor{1db} @subsection No_Implicit_Heap_Allocations @@ -12631,7 +12658,7 @@ types. [RM D.7] No constructs are allowed to cause implicit heap allocation. @node No_Implicit_Protected_Object_Allocations,No_Implicit_Task_Allocations,No_Implicit_Heap_Allocations,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implicit-protected-object-allocations}@anchor{1d8} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implicit-protected-object-allocations}@anchor{1dc} @subsection No_Implicit_Protected_Object_Allocations @@ -12641,7 +12668,7 @@ types. protected object. @node No_Implicit_Task_Allocations,No_Initialize_Scalars,No_Implicit_Protected_Object_Allocations,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implicit-task-allocations}@anchor{1d9} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implicit-task-allocations}@anchor{1dd} @subsection No_Implicit_Task_Allocations @@ -12650,7 +12677,7 @@ protected object. [GNAT] No constructs are allowed to cause implicit heap allocation of a task. @node No_Initialize_Scalars,No_IO,No_Implicit_Task_Allocations,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-initialize-scalars}@anchor{1da} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-initialize-scalars}@anchor{1de} @subsection No_Initialize_Scalars @@ -12662,7 +12689,7 @@ code, and in particular eliminates dummy null initialization routines that are otherwise generated for some record and array types. @node No_IO,No_Local_Allocators,No_Initialize_Scalars,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-io}@anchor{1db} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-io}@anchor{1df} @subsection No_IO @@ -12673,7 +12700,7 @@ dependences on any of the library units Sequential_IO, Direct_IO, Text_IO, Wide_Text_IO, Wide_Wide_Text_IO, or Stream_IO. @node No_Local_Allocators,No_Local_Protected_Objects,No_IO,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-local-allocators}@anchor{1dc} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-local-allocators}@anchor{1e0} @subsection No_Local_Allocators @@ -12684,7 +12711,7 @@ occurrences of an allocator in subprograms, generic subprograms, tasks, and entry bodies. @node No_Local_Protected_Objects,No_Local_Timing_Events,No_Local_Allocators,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-local-protected-objects}@anchor{1dd} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-local-protected-objects}@anchor{1e1} @subsection No_Local_Protected_Objects @@ -12694,7 +12721,7 @@ and entry bodies. only declared at the library level. @node No_Local_Timing_Events,No_Long_Long_Integers,No_Local_Protected_Objects,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-local-timing-events}@anchor{1de} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-local-timing-events}@anchor{1e2} @subsection No_Local_Timing_Events @@ -12704,7 +12731,7 @@ only declared at the library level. declared at the library level. @node No_Long_Long_Integers,No_Multiple_Elaboration,No_Local_Timing_Events,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-long-long-integers}@anchor{1df} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-long-long-integers}@anchor{1e3} @subsection No_Long_Long_Integers @@ -12716,7 +12743,7 @@ implicit base type is Long_Long_Integer, and modular types whose size exceeds Long_Integer'Size. @node No_Multiple_Elaboration,No_Nested_Finalization,No_Long_Long_Integers,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-multiple-elaboration}@anchor{1e0} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-multiple-elaboration}@anchor{1e4} @subsection No_Multiple_Elaboration @@ -12732,7 +12759,7 @@ possible, including non-Ada main programs and Stand Alone libraries, are not permitted and will be diagnosed by the binder. @node No_Nested_Finalization,No_Protected_Type_Allocators,No_Multiple_Elaboration,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-nested-finalization}@anchor{1e1} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-nested-finalization}@anchor{1e5} @subsection No_Nested_Finalization @@ -12741,7 +12768,7 @@ permitted and will be diagnosed by the binder. [RM D.7] All objects requiring finalization are declared at the library level. @node No_Protected_Type_Allocators,No_Protected_Types,No_Nested_Finalization,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-protected-type-allocators}@anchor{1e2} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-protected-type-allocators}@anchor{1e6} @subsection No_Protected_Type_Allocators @@ -12751,7 +12778,7 @@ permitted and will be diagnosed by the binder. expressions that attempt to allocate protected objects. @node No_Protected_Types,No_Recursion,No_Protected_Type_Allocators,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-protected-types}@anchor{1e3} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-protected-types}@anchor{1e7} @subsection No_Protected_Types @@ -12761,7 +12788,7 @@ expressions that attempt to allocate protected objects. declarations of protected types or protected objects. @node No_Recursion,No_Reentrancy,No_Protected_Types,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-recursion}@anchor{1e4} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-recursion}@anchor{1e8} @subsection No_Recursion @@ -12771,7 +12798,7 @@ declarations of protected types or protected objects. part of its execution. @node No_Reentrancy,No_Relative_Delay,No_Recursion,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-reentrancy}@anchor{1e5} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-reentrancy}@anchor{1e9} @subsection No_Reentrancy @@ -12781,7 +12808,7 @@ part of its execution. two tasks at the same time. @node No_Relative_Delay,No_Requeue_Statements,No_Reentrancy,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-relative-delay}@anchor{1e6} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-relative-delay}@anchor{1ea} @subsection No_Relative_Delay @@ -12792,7 +12819,7 @@ relative statements and prevents expressions such as @code{delay 1.23;} from appearing in source code. @node No_Requeue_Statements,No_Secondary_Stack,No_Relative_Delay,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-requeue-statements}@anchor{1e7} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-requeue-statements}@anchor{1eb} @subsection No_Requeue_Statements @@ -12810,7 +12837,7 @@ compatibility purposes (and a warning will be generated for its use if warnings on oNobsolescent features are activated). @node No_Secondary_Stack,No_Select_Statements,No_Requeue_Statements,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-secondary-stack}@anchor{1e8} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-secondary-stack}@anchor{1ec} @subsection No_Secondary_Stack @@ -12823,7 +12850,7 @@ stack is used to implement functions returning unconstrained objects secondary stacks for tasks (excluding the environment task) at run time. @node No_Select_Statements,No_Specific_Termination_Handlers,No_Secondary_Stack,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-select-statements}@anchor{1e9} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-select-statements}@anchor{1ed} @subsection No_Select_Statements @@ -12833,7 +12860,7 @@ secondary stacks for tasks (excluding the environment task) at run time. kind are permitted, that is the keyword @code{select} may not appear. @node No_Specific_Termination_Handlers,No_Specification_of_Aspect,No_Select_Statements,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-specific-termination-handlers}@anchor{1ea} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-specific-termination-handlers}@anchor{1ee} @subsection No_Specific_Termination_Handlers @@ -12843,7 +12870,7 @@ kind are permitted, that is the keyword @code{select} may not appear. or to Ada.Task_Termination.Specific_Handler. @node No_Specification_of_Aspect,No_Standard_Allocators_After_Elaboration,No_Specific_Termination_Handlers,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-specification-of-aspect}@anchor{1eb} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-specification-of-aspect}@anchor{1ef} @subsection No_Specification_of_Aspect @@ -12854,7 +12881,7 @@ specification, attribute definition clause, or pragma is given for a given aspect. @node No_Standard_Allocators_After_Elaboration,No_Standard_Storage_Pools,No_Specification_of_Aspect,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-standard-allocators-after-elaboration}@anchor{1ec} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-standard-allocators-after-elaboration}@anchor{1f0} @subsection No_Standard_Allocators_After_Elaboration @@ -12866,7 +12893,7 @@ library items of the partition has completed. Otherwise, Storage_Error is raised. @node No_Standard_Storage_Pools,No_Stream_Optimizations,No_Standard_Allocators_After_Elaboration,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-standard-storage-pools}@anchor{1ed} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-standard-storage-pools}@anchor{1f1} @subsection No_Standard_Storage_Pools @@ -12878,7 +12905,7 @@ have an explicit Storage_Pool attribute defined specifying a user-defined storage pool. @node No_Stream_Optimizations,No_Streams,No_Standard_Storage_Pools,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-stream-optimizations}@anchor{1ee} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-stream-optimizations}@anchor{1f2} @subsection No_Stream_Optimizations @@ -12891,7 +12918,7 @@ due to their superior performance. When this restriction is in effect, the compiler performs all IO operations on a per-character basis. @node No_Streams,No_Task_Allocators,No_Stream_Optimizations,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-streams}@anchor{1ef} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-streams}@anchor{1f3} @subsection No_Streams @@ -12912,7 +12939,7 @@ unit declaring a tagged type should be compiled with the restriction, though this is not required. @node No_Task_Allocators,No_Task_At_Interrupt_Priority,No_Streams,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-task-allocators}@anchor{1f0} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-task-allocators}@anchor{1f4} @subsection No_Task_Allocators @@ -12922,7 +12949,7 @@ though this is not required. or types containing task subcomponents. @node No_Task_At_Interrupt_Priority,No_Task_Attributes_Package,No_Task_Allocators,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-task-at-interrupt-priority}@anchor{1f1} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-task-at-interrupt-priority}@anchor{1f5} @subsection No_Task_At_Interrupt_Priority @@ -12934,7 +12961,7 @@ a consequence, the tasks are always created with a priority below that an interrupt priority. @node No_Task_Attributes_Package,No_Task_Hierarchy,No_Task_At_Interrupt_Priority,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-task-attributes-package}@anchor{1f2} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-task-attributes-package}@anchor{1f6} @subsection No_Task_Attributes_Package @@ -12951,7 +12978,7 @@ compatibility purposes (and a warning will be generated for its use if warnings on obsolescent features are activated). @node No_Task_Hierarchy,No_Task_Termination,No_Task_Attributes_Package,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-task-hierarchy}@anchor{1f3} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-task-hierarchy}@anchor{1f7} @subsection No_Task_Hierarchy @@ -12961,7 +12988,7 @@ warnings on obsolescent features are activated). directly on the environment task of the partition. @node No_Task_Termination,No_Tasking,No_Task_Hierarchy,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-task-termination}@anchor{1f4} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-task-termination}@anchor{1f8} @subsection No_Task_Termination @@ -12970,7 +12997,7 @@ directly on the environment task of the partition. [RM D.7] Tasks that terminate are erroneous. @node No_Tasking,No_Terminate_Alternatives,No_Task_Termination,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-tasking}@anchor{1f5} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-tasking}@anchor{1f9} @subsection No_Tasking @@ -12983,7 +13010,7 @@ and cause an error message to be output either by the compiler or binder. @node No_Terminate_Alternatives,No_Unchecked_Access,No_Tasking,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-terminate-alternatives}@anchor{1f6} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-terminate-alternatives}@anchor{1fa} @subsection No_Terminate_Alternatives @@ -12992,7 +13019,7 @@ binder. [RM D.7] There are no selective accepts with terminate alternatives. @node No_Unchecked_Access,No_Unchecked_Conversion,No_Terminate_Alternatives,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-unchecked-access}@anchor{1f7} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-unchecked-access}@anchor{1fb} @subsection No_Unchecked_Access @@ -13002,7 +13029,7 @@ binder. occurrences of the Unchecked_Access attribute. @node No_Unchecked_Conversion,No_Unchecked_Deallocation,No_Unchecked_Access,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-unchecked-conversion}@anchor{1f8} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-unchecked-conversion}@anchor{1fc} @subsection No_Unchecked_Conversion @@ -13012,7 +13039,7 @@ occurrences of the Unchecked_Access attribute. dependences on the predefined generic function Unchecked_Conversion. @node No_Unchecked_Deallocation,No_Use_Of_Entity,No_Unchecked_Conversion,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-unchecked-deallocation}@anchor{1f9} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-unchecked-deallocation}@anchor{1fd} @subsection No_Unchecked_Deallocation @@ -13022,7 +13049,7 @@ dependences on the predefined generic function Unchecked_Conversion. dependences on the predefined generic procedure Unchecked_Deallocation. @node No_Use_Of_Entity,Pure_Barriers,No_Unchecked_Deallocation,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-use-of-entity}@anchor{1fa} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-use-of-entity}@anchor{1fe} @subsection No_Use_Of_Entity @@ -13042,7 +13069,7 @@ No_Use_Of_Entity => Ada.Text_IO.Put_Line @end example @node Pure_Barriers,Simple_Barriers,No_Use_Of_Entity,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions pure-barriers}@anchor{1fb} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions pure-barriers}@anchor{1ff} @subsection Pure_Barriers @@ -13093,7 +13120,7 @@ but still ensures absence of side effects, exceptions, and recursion during the evaluation of the barriers. @node Simple_Barriers,Static_Priorities,Pure_Barriers,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions simple-barriers}@anchor{1fc} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions simple-barriers}@anchor{200} @subsection Simple_Barriers @@ -13112,7 +13139,7 @@ compatibility purposes (and a warning will be generated for its use if warnings on obsolescent features are activated). @node Static_Priorities,Static_Storage_Size,Simple_Barriers,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions static-priorities}@anchor{1fd} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions static-priorities}@anchor{201} @subsection Static_Priorities @@ -13123,7 +13150,7 @@ are static, and that there are no dependences on the package @code{Ada.Dynamic_Priorities}. @node Static_Storage_Size,,Static_Priorities,Partition-Wide Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions static-storage-size}@anchor{1fe} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions static-storage-size}@anchor{202} @subsection Static_Storage_Size @@ -13133,7 +13160,7 @@ are static, and that there are no dependences on the package in a Storage_Size pragma or attribute definition clause is static. @node Program Unit Level Restrictions,,Partition-Wide Restrictions,Standard and Implementation Defined Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions program-unit-level-restrictions}@anchor{1ff}@anchor{gnat_rm/standard_and_implementation_defined_restrictions id3}@anchor{200} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions program-unit-level-restrictions}@anchor{203}@anchor{gnat_rm/standard_and_implementation_defined_restrictions id3}@anchor{204} @section Program Unit Level Restrictions @@ -13163,7 +13190,7 @@ other compilation units in the partition. @end menu @node No_Elaboration_Code,No_Dynamic_Sized_Objects,,Program Unit Level Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-elaboration-code}@anchor{201} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-elaboration-code}@anchor{205} @subsection No_Elaboration_Code @@ -13219,7 +13246,7 @@ associated with the unit. This counter is typically used to check for access before elaboration and to control multiple elaboration attempts. @node No_Dynamic_Sized_Objects,No_Entry_Queue,No_Elaboration_Code,Program Unit Level Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-dynamic-sized-objects}@anchor{202} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-dynamic-sized-objects}@anchor{206} @subsection No_Dynamic_Sized_Objects @@ -13237,7 +13264,7 @@ access discriminants. It is often a good idea to combine this restriction with No_Secondary_Stack. @node No_Entry_Queue,No_Implementation_Aspect_Specifications,No_Dynamic_Sized_Objects,Program Unit Level Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-entry-queue}@anchor{203} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-entry-queue}@anchor{207} @subsection No_Entry_Queue @@ -13250,7 +13277,7 @@ checked at compile time. A program execution is erroneous if an attempt is made to queue a second task on such an entry. @node No_Implementation_Aspect_Specifications,No_Implementation_Attributes,No_Entry_Queue,Program Unit Level Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implementation-aspect-specifications}@anchor{204} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implementation-aspect-specifications}@anchor{208} @subsection No_Implementation_Aspect_Specifications @@ -13261,7 +13288,7 @@ GNAT-defined aspects are present. With this restriction, the only aspects that can be used are those defined in the Ada Reference Manual. @node No_Implementation_Attributes,No_Implementation_Identifiers,No_Implementation_Aspect_Specifications,Program Unit Level Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implementation-attributes}@anchor{205} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implementation-attributes}@anchor{209} @subsection No_Implementation_Attributes @@ -13273,7 +13300,7 @@ attributes that can be used are those defined in the Ada Reference Manual. @node No_Implementation_Identifiers,No_Implementation_Pragmas,No_Implementation_Attributes,Program Unit Level Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implementation-identifiers}@anchor{206} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implementation-identifiers}@anchor{20a} @subsection No_Implementation_Identifiers @@ -13284,7 +13311,7 @@ implementation-defined identifiers (marked with pragma Implementation_Defined) occur within language-defined packages. @node No_Implementation_Pragmas,No_Implementation_Restrictions,No_Implementation_Identifiers,Program Unit Level Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implementation-pragmas}@anchor{207} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implementation-pragmas}@anchor{20b} @subsection No_Implementation_Pragmas @@ -13295,7 +13322,7 @@ GNAT-defined pragmas are present. With this restriction, the only pragmas that can be used are those defined in the Ada Reference Manual. @node No_Implementation_Restrictions,No_Implementation_Units,No_Implementation_Pragmas,Program Unit Level Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implementation-restrictions}@anchor{208} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implementation-restrictions}@anchor{20c} @subsection No_Implementation_Restrictions @@ -13307,7 +13334,7 @@ are present. With this restriction, the only other restriction identifiers that can be used are those defined in the Ada Reference Manual. @node No_Implementation_Units,No_Implicit_Aliasing,No_Implementation_Restrictions,Program Unit Level Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implementation-units}@anchor{209} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implementation-units}@anchor{20d} @subsection No_Implementation_Units @@ -13318,7 +13345,7 @@ mention in the context clause of any implementation-defined descendants of packages Ada, Interfaces, or System. @node No_Implicit_Aliasing,No_Implicit_Loops,No_Implementation_Units,Program Unit Level Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implicit-aliasing}@anchor{20a} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implicit-aliasing}@anchor{20e} @subsection No_Implicit_Aliasing @@ -13333,7 +13360,7 @@ to be aliased, and in such cases, it can always be replaced by the standard attribute Unchecked_Access which is preferable. @node No_Implicit_Loops,No_Obsolescent_Features,No_Implicit_Aliasing,Program Unit Level Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implicit-loops}@anchor{20b} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-implicit-loops}@anchor{20f} @subsection No_Implicit_Loops @@ -13350,7 +13377,7 @@ arrays larger than about 5000 scalar components. Note that if this restriction is set in the spec of a package, it will not apply to its body. @node No_Obsolescent_Features,No_Wide_Characters,No_Implicit_Loops,Program Unit Level Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-obsolescent-features}@anchor{20c} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-obsolescent-features}@anchor{210} @subsection No_Obsolescent_Features @@ -13360,7 +13387,7 @@ is set in the spec of a package, it will not apply to its body. features are used, as defined in Annex J of the Ada Reference Manual. @node No_Wide_Characters,Static_Dispatch_Tables,No_Obsolescent_Features,Program Unit Level Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-wide-characters}@anchor{20d} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-wide-characters}@anchor{211} @subsection No_Wide_Characters @@ -13374,7 +13401,7 @@ appear in the program (that is literals representing characters not in type @code{Character}). @node Static_Dispatch_Tables,SPARK_05,No_Wide_Characters,Program Unit Level Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions static-dispatch-tables}@anchor{20e} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions static-dispatch-tables}@anchor{212} @subsection Static_Dispatch_Tables @@ -13384,7 +13411,7 @@ type @code{Character}). associated with dispatch tables can be placed in read-only memory. @node SPARK_05,,Static_Dispatch_Tables,Program Unit Level Restrictions -@anchor{gnat_rm/standard_and_implementation_defined_restrictions spark-05}@anchor{20f} +@anchor{gnat_rm/standard_and_implementation_defined_restrictions spark-05}@anchor{213} @subsection SPARK_05 @@ -13758,7 +13785,7 @@ violations will be reported for constructs forbidden in SPARK 95, instead of SPARK 2005. @node Implementation Advice,Implementation Defined Characteristics,Standard and Implementation Defined Restrictions,Top -@anchor{gnat_rm/implementation_advice doc}@anchor{210}@anchor{gnat_rm/implementation_advice implementation-advice}@anchor{a}@anchor{gnat_rm/implementation_advice id1}@anchor{211} +@anchor{gnat_rm/implementation_advice doc}@anchor{214}@anchor{gnat_rm/implementation_advice implementation-advice}@anchor{a}@anchor{gnat_rm/implementation_advice id1}@anchor{215} @chapter Implementation Advice @@ -13855,7 +13882,7 @@ case the text describes what GNAT does and why. @end menu @node RM 1 1 3 20 Error Detection,RM 1 1 3 31 Child Units,,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-1-1-3-20-error-detection}@anchor{212} +@anchor{gnat_rm/implementation_advice rm-1-1-3-20-error-detection}@anchor{216} @section RM 1.1.3(20): Error Detection @@ -13872,7 +13899,7 @@ or diagnosed at compile time. @geindex Child Units @node RM 1 1 3 31 Child Units,RM 1 1 5 12 Bounded Errors,RM 1 1 3 20 Error Detection,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-1-1-3-31-child-units}@anchor{213} +@anchor{gnat_rm/implementation_advice rm-1-1-3-31-child-units}@anchor{217} @section RM 1.1.3(31): Child Units @@ -13888,7 +13915,7 @@ Followed. @geindex Bounded errors @node RM 1 1 5 12 Bounded Errors,RM 2 8 16 Pragmas,RM 1 1 3 31 Child Units,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-1-1-5-12-bounded-errors}@anchor{214} +@anchor{gnat_rm/implementation_advice rm-1-1-5-12-bounded-errors}@anchor{218} @section RM 1.1.5(12): Bounded Errors @@ -13905,7 +13932,7 @@ runtime. @geindex Pragmas @node RM 2 8 16 Pragmas,RM 2 8 17-19 Pragmas,RM 1 1 5 12 Bounded Errors,Implementation Advice -@anchor{gnat_rm/implementation_advice id2}@anchor{215}@anchor{gnat_rm/implementation_advice rm-2-8-16-pragmas}@anchor{216} +@anchor{gnat_rm/implementation_advice id2}@anchor{219}@anchor{gnat_rm/implementation_advice rm-2-8-16-pragmas}@anchor{21a} @section RM 2.8(16): Pragmas @@ -14018,7 +14045,7 @@ that this advice not be followed. For details see @ref{7,,Implementation Defined Pragmas}. @node RM 2 8 17-19 Pragmas,RM 3 5 2 5 Alternative Character Sets,RM 2 8 16 Pragmas,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-2-8-17-19-pragmas}@anchor{217} +@anchor{gnat_rm/implementation_advice rm-2-8-17-19-pragmas}@anchor{21b} @section RM 2.8(17-19): Pragmas @@ -14039,14 +14066,14 @@ replacing @code{library_items}." @end itemize @end quotation -See @ref{216,,RM 2.8(16); Pragmas}. +See @ref{21a,,RM 2.8(16); Pragmas}. @geindex Character Sets @geindex Alternative Character Sets @node RM 3 5 2 5 Alternative Character Sets,RM 3 5 4 28 Integer Types,RM 2 8 17-19 Pragmas,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-3-5-2-5-alternative-character-sets}@anchor{218} +@anchor{gnat_rm/implementation_advice rm-3-5-2-5-alternative-character-sets}@anchor{21c} @section RM 3.5.2(5): Alternative Character Sets @@ -14074,7 +14101,7 @@ there is no such restriction. @geindex Integer types @node RM 3 5 4 28 Integer Types,RM 3 5 4 29 Integer Types,RM 3 5 2 5 Alternative Character Sets,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-3-5-4-28-integer-types}@anchor{219} +@anchor{gnat_rm/implementation_advice rm-3-5-4-28-integer-types}@anchor{21d} @section RM 3.5.4(28): Integer Types @@ -14093,7 +14120,7 @@ are supported for convenient interface to C, and so that all hardware types of the machine are easily available. @node RM 3 5 4 29 Integer Types,RM 3 5 5 8 Enumeration Values,RM 3 5 4 28 Integer Types,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-3-5-4-29-integer-types}@anchor{21a} +@anchor{gnat_rm/implementation_advice rm-3-5-4-29-integer-types}@anchor{21e} @section RM 3.5.4(29): Integer Types @@ -14109,7 +14136,7 @@ Followed. @geindex Enumeration values @node RM 3 5 5 8 Enumeration Values,RM 3 5 7 17 Float Types,RM 3 5 4 29 Integer Types,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-3-5-5-8-enumeration-values}@anchor{21b} +@anchor{gnat_rm/implementation_advice rm-3-5-5-8-enumeration-values}@anchor{21f} @section RM 3.5.5(8): Enumeration Values @@ -14129,7 +14156,7 @@ Followed. @geindex Float types @node RM 3 5 7 17 Float Types,RM 3 6 2 11 Multidimensional Arrays,RM 3 5 5 8 Enumeration Values,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-3-5-7-17-float-types}@anchor{21c} +@anchor{gnat_rm/implementation_advice rm-3-5-7-17-float-types}@anchor{220} @section RM 3.5.7(17): Float Types @@ -14159,7 +14186,7 @@ since this is a software rather than a hardware format. @geindex multidimensional @node RM 3 6 2 11 Multidimensional Arrays,RM 9 6 30-31 Duration'Small,RM 3 5 7 17 Float Types,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-3-6-2-11-multidimensional-arrays}@anchor{21d} +@anchor{gnat_rm/implementation_advice rm-3-6-2-11-multidimensional-arrays}@anchor{221} @section RM 3.6.2(11): Multidimensional Arrays @@ -14177,7 +14204,7 @@ Followed. @geindex Duration'Small @node RM 9 6 30-31 Duration'Small,RM 10 2 1 12 Consistent Representation,RM 3 6 2 11 Multidimensional Arrays,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-9-6-30-31-duration-small}@anchor{21e} +@anchor{gnat_rm/implementation_advice rm-9-6-30-31-duration-small}@anchor{222} @section RM 9.6(30-31): Duration'Small @@ -14198,7 +14225,7 @@ it need not be the same time base as used for @code{Calendar.Clock}." Followed. @node RM 10 2 1 12 Consistent Representation,RM 11 4 1 19 Exception Information,RM 9 6 30-31 Duration'Small,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-10-2-1-12-consistent-representation}@anchor{21f} +@anchor{gnat_rm/implementation_advice rm-10-2-1-12-consistent-representation}@anchor{223} @section RM 10.2.1(12): Consistent Representation @@ -14220,7 +14247,7 @@ advice without severely impacting efficiency of execution. @geindex Exception information @node RM 11 4 1 19 Exception Information,RM 11 5 28 Suppression of Checks,RM 10 2 1 12 Consistent Representation,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-11-4-1-19-exception-information}@anchor{220} +@anchor{gnat_rm/implementation_advice rm-11-4-1-19-exception-information}@anchor{224} @section RM 11.4.1(19): Exception Information @@ -14251,7 +14278,7 @@ Pragma @code{Discard_Names}. @geindex suppression of @node RM 11 5 28 Suppression of Checks,RM 13 1 21-24 Representation Clauses,RM 11 4 1 19 Exception Information,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-11-5-28-suppression-of-checks}@anchor{221} +@anchor{gnat_rm/implementation_advice rm-11-5-28-suppression-of-checks}@anchor{225} @section RM 11.5(28): Suppression of Checks @@ -14266,7 +14293,7 @@ Followed. @geindex Representation clauses @node RM 13 1 21-24 Representation Clauses,RM 13 2 6-8 Packed Types,RM 11 5 28 Suppression of Checks,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-1-21-24-representation-clauses}@anchor{222} +@anchor{gnat_rm/implementation_advice rm-13-1-21-24-representation-clauses}@anchor{226} @section RM 13.1 (21-24): Representation Clauses @@ -14315,7 +14342,7 @@ Followed. @geindex Packed types @node RM 13 2 6-8 Packed Types,RM 13 3 14-19 Address Clauses,RM 13 1 21-24 Representation Clauses,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-2-6-8-packed-types}@anchor{223} +@anchor{gnat_rm/implementation_advice rm-13-2-6-8-packed-types}@anchor{227} @section RM 13.2(6-8): Packed Types @@ -14354,7 +14381,7 @@ Followed. @geindex Address clauses @node RM 13 3 14-19 Address Clauses,RM 13 3 29-35 Alignment Clauses,RM 13 2 6-8 Packed Types,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-3-14-19-address-clauses}@anchor{224} +@anchor{gnat_rm/implementation_advice rm-13-3-14-19-address-clauses}@anchor{228} @section RM 13.3(14-19): Address Clauses @@ -14407,7 +14434,7 @@ Followed. @geindex Alignment clauses @node RM 13 3 29-35 Alignment Clauses,RM 13 3 42-43 Size Clauses,RM 13 3 14-19 Address Clauses,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-3-29-35-alignment-clauses}@anchor{225} +@anchor{gnat_rm/implementation_advice rm-13-3-29-35-alignment-clauses}@anchor{229} @section RM 13.3(29-35): Alignment Clauses @@ -14464,7 +14491,7 @@ Followed. @geindex Size clauses @node RM 13 3 42-43 Size Clauses,RM 13 3 50-56 Size Clauses,RM 13 3 29-35 Alignment Clauses,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-3-42-43-size-clauses}@anchor{226} +@anchor{gnat_rm/implementation_advice rm-13-3-42-43-size-clauses}@anchor{22a} @section RM 13.3(42-43): Size Clauses @@ -14482,7 +14509,7 @@ object's @code{Alignment} (if the @code{Alignment} is nonzero)." Followed. @node RM 13 3 50-56 Size Clauses,RM 13 3 71-73 Component Size Clauses,RM 13 3 42-43 Size Clauses,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-3-50-56-size-clauses}@anchor{227} +@anchor{gnat_rm/implementation_advice rm-13-3-50-56-size-clauses}@anchor{22b} @section RM 13.3(50-56): Size Clauses @@ -14533,7 +14560,7 @@ Followed. @geindex Component_Size clauses @node RM 13 3 71-73 Component Size Clauses,RM 13 4 9-10 Enumeration Representation Clauses,RM 13 3 50-56 Size Clauses,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-3-71-73-component-size-clauses}@anchor{228} +@anchor{gnat_rm/implementation_advice rm-13-3-71-73-component-size-clauses}@anchor{22c} @section RM 13.3(71-73): Component Size Clauses @@ -14567,7 +14594,7 @@ Followed. @geindex enumeration @node RM 13 4 9-10 Enumeration Representation Clauses,RM 13 5 1 17-22 Record Representation Clauses,RM 13 3 71-73 Component Size Clauses,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-4-9-10-enumeration-representation-clauses}@anchor{229} +@anchor{gnat_rm/implementation_advice rm-13-4-9-10-enumeration-representation-clauses}@anchor{22d} @section RM 13.4(9-10): Enumeration Representation Clauses @@ -14589,7 +14616,7 @@ Followed. @geindex records @node RM 13 5 1 17-22 Record Representation Clauses,RM 13 5 2 5 Storage Place Attributes,RM 13 4 9-10 Enumeration Representation Clauses,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-5-1-17-22-record-representation-clauses}@anchor{22a} +@anchor{gnat_rm/implementation_advice rm-13-5-1-17-22-record-representation-clauses}@anchor{22e} @section RM 13.5.1(17-22): Record Representation Clauses @@ -14649,7 +14676,7 @@ and all mentioned features are implemented. @geindex Storage place attributes @node RM 13 5 2 5 Storage Place Attributes,RM 13 5 3 7-8 Bit Ordering,RM 13 5 1 17-22 Record Representation Clauses,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-5-2-5-storage-place-attributes}@anchor{22b} +@anchor{gnat_rm/implementation_advice rm-13-5-2-5-storage-place-attributes}@anchor{22f} @section RM 13.5.2(5): Storage Place Attributes @@ -14669,7 +14696,7 @@ Followed. There are no such components in GNAT. @geindex Bit ordering @node RM 13 5 3 7-8 Bit Ordering,RM 13 7 37 Address as Private,RM 13 5 2 5 Storage Place Attributes,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-5-3-7-8-bit-ordering}@anchor{22c} +@anchor{gnat_rm/implementation_advice rm-13-5-3-7-8-bit-ordering}@anchor{230} @section RM 13.5.3(7-8): Bit Ordering @@ -14689,7 +14716,7 @@ Thus non-default bit ordering is not supported. @geindex as private type @node RM 13 7 37 Address as Private,RM 13 7 1 16 Address Operations,RM 13 5 3 7-8 Bit Ordering,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-7-37-address-as-private}@anchor{22d} +@anchor{gnat_rm/implementation_advice rm-13-7-37-address-as-private}@anchor{231} @section RM 13.7(37): Address as Private @@ -14707,7 +14734,7 @@ Followed. @geindex operations of @node RM 13 7 1 16 Address Operations,RM 13 9 14-17 Unchecked Conversion,RM 13 7 37 Address as Private,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-7-1-16-address-operations}@anchor{22e} +@anchor{gnat_rm/implementation_advice rm-13-7-1-16-address-operations}@anchor{232} @section RM 13.7.1(16): Address Operations @@ -14725,7 +14752,7 @@ operation raises @code{Program_Error}, since all operations make sense. @geindex Unchecked conversion @node RM 13 9 14-17 Unchecked Conversion,RM 13 11 23-25 Implicit Heap Usage,RM 13 7 1 16 Address Operations,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-9-14-17-unchecked-conversion}@anchor{22f} +@anchor{gnat_rm/implementation_advice rm-13-9-14-17-unchecked-conversion}@anchor{233} @section RM 13.9(14-17): Unchecked Conversion @@ -14769,7 +14796,7 @@ Followed. @geindex implicit @node RM 13 11 23-25 Implicit Heap Usage,RM 13 11 2 17 Unchecked Deallocation,RM 13 9 14-17 Unchecked Conversion,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-11-23-25-implicit-heap-usage}@anchor{230} +@anchor{gnat_rm/implementation_advice rm-13-11-23-25-implicit-heap-usage}@anchor{234} @section RM 13.11(23-25): Implicit Heap Usage @@ -14820,7 +14847,7 @@ Followed. @geindex Unchecked deallocation @node RM 13 11 2 17 Unchecked Deallocation,RM 13 13 2 17 Stream Oriented Attributes,RM 13 11 23-25 Implicit Heap Usage,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-11-2-17-unchecked-deallocation}@anchor{231} +@anchor{gnat_rm/implementation_advice rm-13-11-2-17-unchecked-deallocation}@anchor{235} @section RM 13.11.2(17): Unchecked Deallocation @@ -14835,7 +14862,7 @@ Followed. @geindex Stream oriented attributes @node RM 13 13 2 17 Stream Oriented Attributes,RM A 1 52 Names of Predefined Numeric Types,RM 13 11 2 17 Unchecked Deallocation,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-13-2-17-stream-oriented-attributes}@anchor{232} +@anchor{gnat_rm/implementation_advice rm-13-13-2-17-stream-oriented-attributes}@anchor{236} @section RM 13.13.2(17): Stream Oriented Attributes @@ -14890,7 +14917,7 @@ the @emph{GNAT and Libraries} section of the @cite{GNAT User's Guide}. @end itemize @node RM A 1 52 Names of Predefined Numeric Types,RM A 3 2 49 Ada Characters Handling,RM 13 13 2 17 Stream Oriented Attributes,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-a-1-52-names-of-predefined-numeric-types}@anchor{233} +@anchor{gnat_rm/implementation_advice rm-a-1-52-names-of-predefined-numeric-types}@anchor{237} @section RM A.1(52): Names of Predefined Numeric Types @@ -14908,7 +14935,7 @@ Followed. @geindex Ada.Characters.Handling @node RM A 3 2 49 Ada Characters Handling,RM A 4 4 106 Bounded-Length String Handling,RM A 1 52 Names of Predefined Numeric Types,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-a-3-2-49-ada-characters-handling}@anchor{234} +@anchor{gnat_rm/implementation_advice rm-a-3-2-49-ada-characters-handling}@anchor{238} @section RM A.3.2(49): @code{Ada.Characters.Handling} @@ -14925,7 +14952,7 @@ Followed. GNAT provides no such localized definitions. @geindex Bounded-length strings @node RM A 4 4 106 Bounded-Length String Handling,RM A 5 2 46-47 Random Number Generation,RM A 3 2 49 Ada Characters Handling,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-a-4-4-106-bounded-length-string-handling}@anchor{235} +@anchor{gnat_rm/implementation_advice rm-a-4-4-106-bounded-length-string-handling}@anchor{239} @section RM A.4.4(106): Bounded-Length String Handling @@ -14940,7 +14967,7 @@ Followed. No implicit pointers or dynamic allocation are used. @geindex Random number generation @node RM A 5 2 46-47 Random Number Generation,RM A 10 7 23 Get_Immediate,RM A 4 4 106 Bounded-Length String Handling,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-a-5-2-46-47-random-number-generation}@anchor{236} +@anchor{gnat_rm/implementation_advice rm-a-5-2-46-47-random-number-generation}@anchor{23a} @section RM A.5.2(46-47): Random Number Generation @@ -14969,7 +14996,7 @@ condition here to hold true. @geindex Get_Immediate @node RM A 10 7 23 Get_Immediate,RM B 1 39-41 Pragma Export,RM A 5 2 46-47 Random Number Generation,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-a-10-7-23-get-immediate}@anchor{237} +@anchor{gnat_rm/implementation_advice rm-a-10-7-23-get-immediate}@anchor{23b} @section RM A.10.7(23): @code{Get_Immediate} @@ -14993,7 +15020,7 @@ this functionality. @geindex Export @node RM B 1 39-41 Pragma Export,RM B 2 12-13 Package Interfaces,RM A 10 7 23 Get_Immediate,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-b-1-39-41-pragma-export}@anchor{238} +@anchor{gnat_rm/implementation_advice rm-b-1-39-41-pragma-export}@anchor{23c} @section RM B.1(39-41): Pragma @code{Export} @@ -15041,7 +15068,7 @@ Followed. @geindex Interfaces @node RM B 2 12-13 Package Interfaces,RM B 3 63-71 Interfacing with C,RM B 1 39-41 Pragma Export,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-b-2-12-13-package-interfaces}@anchor{239} +@anchor{gnat_rm/implementation_advice rm-b-2-12-13-package-interfaces}@anchor{23d} @section RM B.2(12-13): Package @code{Interfaces} @@ -15071,7 +15098,7 @@ Followed. GNAT provides all the packages described in this section. @geindex interfacing with @node RM B 3 63-71 Interfacing with C,RM B 4 95-98 Interfacing with COBOL,RM B 2 12-13 Package Interfaces,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-b-3-63-71-interfacing-with-c}@anchor{23a} +@anchor{gnat_rm/implementation_advice rm-b-3-63-71-interfacing-with-c}@anchor{23e} @section RM B.3(63-71): Interfacing with C @@ -15159,7 +15186,7 @@ Followed. @geindex interfacing with @node RM B 4 95-98 Interfacing with COBOL,RM B 5 22-26 Interfacing with Fortran,RM B 3 63-71 Interfacing with C,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-b-4-95-98-interfacing-with-cobol}@anchor{23b} +@anchor{gnat_rm/implementation_advice rm-b-4-95-98-interfacing-with-cobol}@anchor{23f} @section RM B.4(95-98): Interfacing with COBOL @@ -15200,7 +15227,7 @@ Followed. @geindex interfacing with @node RM B 5 22-26 Interfacing with Fortran,RM C 1 3-5 Access to Machine Operations,RM B 4 95-98 Interfacing with COBOL,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-b-5-22-26-interfacing-with-fortran}@anchor{23c} +@anchor{gnat_rm/implementation_advice rm-b-5-22-26-interfacing-with-fortran}@anchor{240} @section RM B.5(22-26): Interfacing with Fortran @@ -15251,7 +15278,7 @@ Followed. @geindex Machine operations @node RM C 1 3-5 Access to Machine Operations,RM C 1 10-16 Access to Machine Operations,RM B 5 22-26 Interfacing with Fortran,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-c-1-3-5-access-to-machine-operations}@anchor{23d} +@anchor{gnat_rm/implementation_advice rm-c-1-3-5-access-to-machine-operations}@anchor{241} @section RM C.1(3-5): Access to Machine Operations @@ -15286,7 +15313,7 @@ object that is specified as exported." Followed. @node RM C 1 10-16 Access to Machine Operations,RM C 3 28 Interrupt Support,RM C 1 3-5 Access to Machine Operations,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-c-1-10-16-access-to-machine-operations}@anchor{23e} +@anchor{gnat_rm/implementation_advice rm-c-1-10-16-access-to-machine-operations}@anchor{242} @section RM C.1(10-16): Access to Machine Operations @@ -15347,7 +15374,7 @@ Followed on any target supporting such operations. @geindex Interrupt support @node RM C 3 28 Interrupt Support,RM C 3 1 20-21 Protected Procedure Handlers,RM C 1 10-16 Access to Machine Operations,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-c-3-28-interrupt-support}@anchor{23f} +@anchor{gnat_rm/implementation_advice rm-c-3-28-interrupt-support}@anchor{243} @section RM C.3(28): Interrupt Support @@ -15365,7 +15392,7 @@ of interrupt blocking. @geindex Protected procedure handlers @node RM C 3 1 20-21 Protected Procedure Handlers,RM C 3 2 25 Package Interrupts,RM C 3 28 Interrupt Support,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-c-3-1-20-21-protected-procedure-handlers}@anchor{240} +@anchor{gnat_rm/implementation_advice rm-c-3-1-20-21-protected-procedure-handlers}@anchor{244} @section RM C.3.1(20-21): Protected Procedure Handlers @@ -15391,7 +15418,7 @@ Followed. Compile time warnings are given when possible. @geindex Interrupts @node RM C 3 2 25 Package Interrupts,RM C 4 14 Pre-elaboration Requirements,RM C 3 1 20-21 Protected Procedure Handlers,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-c-3-2-25-package-interrupts}@anchor{241} +@anchor{gnat_rm/implementation_advice rm-c-3-2-25-package-interrupts}@anchor{245} @section RM C.3.2(25): Package @code{Interrupts} @@ -15409,7 +15436,7 @@ Followed. @geindex Pre-elaboration requirements @node RM C 4 14 Pre-elaboration Requirements,RM C 5 8 Pragma Discard_Names,RM C 3 2 25 Package Interrupts,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-c-4-14-pre-elaboration-requirements}@anchor{242} +@anchor{gnat_rm/implementation_advice rm-c-4-14-pre-elaboration-requirements}@anchor{246} @section RM C.4(14): Pre-elaboration Requirements @@ -15425,7 +15452,7 @@ Followed. Executable code is generated in some cases, e.g., loops to initialize large arrays. @node RM C 5 8 Pragma Discard_Names,RM C 7 2 30 The Package Task_Attributes,RM C 4 14 Pre-elaboration Requirements,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-c-5-8-pragma-discard-names}@anchor{243} +@anchor{gnat_rm/implementation_advice rm-c-5-8-pragma-discard-names}@anchor{247} @section RM C.5(8): Pragma @code{Discard_Names} @@ -15443,7 +15470,7 @@ Followed. @geindex Task_Attributes @node RM C 7 2 30 The Package Task_Attributes,RM D 3 17 Locking Policies,RM C 5 8 Pragma Discard_Names,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-c-7-2-30-the-package-task-attributes}@anchor{244} +@anchor{gnat_rm/implementation_advice rm-c-7-2-30-the-package-task-attributes}@anchor{248} @section RM C.7.2(30): The Package Task_Attributes @@ -15464,7 +15491,7 @@ Not followed. This implementation is not targeted to such a domain. @geindex Locking Policies @node RM D 3 17 Locking Policies,RM D 4 16 Entry Queuing Policies,RM C 7 2 30 The Package Task_Attributes,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-d-3-17-locking-policies}@anchor{245} +@anchor{gnat_rm/implementation_advice rm-d-3-17-locking-policies}@anchor{249} @section RM D.3(17): Locking Policies @@ -15481,7 +15508,7 @@ whose names (@code{Inheritance_Locking} and @geindex Entry queuing policies @node RM D 4 16 Entry Queuing Policies,RM D 6 9-10 Preemptive Abort,RM D 3 17 Locking Policies,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-d-4-16-entry-queuing-policies}@anchor{246} +@anchor{gnat_rm/implementation_advice rm-d-4-16-entry-queuing-policies}@anchor{24a} @section RM D.4(16): Entry Queuing Policies @@ -15496,7 +15523,7 @@ Followed. No such implementation-defined queuing policies exist. @geindex Preemptive abort @node RM D 6 9-10 Preemptive Abort,RM D 7 21 Tasking Restrictions,RM D 4 16 Entry Queuing Policies,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-d-6-9-10-preemptive-abort}@anchor{247} +@anchor{gnat_rm/implementation_advice rm-d-6-9-10-preemptive-abort}@anchor{24b} @section RM D.6(9-10): Preemptive Abort @@ -15522,7 +15549,7 @@ Followed. @geindex Tasking restrictions @node RM D 7 21 Tasking Restrictions,RM D 8 47-49 Monotonic Time,RM D 6 9-10 Preemptive Abort,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-d-7-21-tasking-restrictions}@anchor{248} +@anchor{gnat_rm/implementation_advice rm-d-7-21-tasking-restrictions}@anchor{24c} @section RM D.7(21): Tasking Restrictions @@ -15541,7 +15568,7 @@ pragma @code{Profile (Restricted)} for more details. @geindex monotonic @node RM D 8 47-49 Monotonic Time,RM E 5 28-29 Partition Communication Subsystem,RM D 7 21 Tasking Restrictions,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-d-8-47-49-monotonic-time}@anchor{249} +@anchor{gnat_rm/implementation_advice rm-d-8-47-49-monotonic-time}@anchor{24d} @section RM D.8(47-49): Monotonic Time @@ -15576,7 +15603,7 @@ Followed. @geindex PCS @node RM E 5 28-29 Partition Communication Subsystem,RM F 7 COBOL Support,RM D 8 47-49 Monotonic Time,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-e-5-28-29-partition-communication-subsystem}@anchor{24a} +@anchor{gnat_rm/implementation_advice rm-e-5-28-29-partition-communication-subsystem}@anchor{24e} @section RM E.5(28-29): Partition Communication Subsystem @@ -15604,7 +15631,7 @@ GNAT. @geindex COBOL support @node RM F 7 COBOL Support,RM F 1 2 Decimal Radix Support,RM E 5 28-29 Partition Communication Subsystem,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-f-7-cobol-support}@anchor{24b} +@anchor{gnat_rm/implementation_advice rm-f-7-cobol-support}@anchor{24f} @section RM F(7): COBOL Support @@ -15624,7 +15651,7 @@ Followed. @geindex Decimal radix support @node RM F 1 2 Decimal Radix Support,RM G Numerics,RM F 7 COBOL Support,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-f-1-2-decimal-radix-support}@anchor{24c} +@anchor{gnat_rm/implementation_advice rm-f-1-2-decimal-radix-support}@anchor{250} @section RM F.1(2): Decimal Radix Support @@ -15640,7 +15667,7 @@ representations. @geindex Numerics @node RM G Numerics,RM G 1 1 56-58 Complex Types,RM F 1 2 Decimal Radix Support,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-g-numerics}@anchor{24d} +@anchor{gnat_rm/implementation_advice rm-g-numerics}@anchor{251} @section RM G: Numerics @@ -15660,7 +15687,7 @@ Followed. @geindex Complex types @node RM G 1 1 56-58 Complex Types,RM G 1 2 49 Complex Elementary Functions,RM G Numerics,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-g-1-1-56-58-complex-types}@anchor{24e} +@anchor{gnat_rm/implementation_advice rm-g-1-1-56-58-complex-types}@anchor{252} @section RM G.1.1(56-58): Complex Types @@ -15722,7 +15749,7 @@ Followed. @geindex Complex elementary functions @node RM G 1 2 49 Complex Elementary Functions,RM G 2 4 19 Accuracy Requirements,RM G 1 1 56-58 Complex Types,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-g-1-2-49-complex-elementary-functions}@anchor{24f} +@anchor{gnat_rm/implementation_advice rm-g-1-2-49-complex-elementary-functions}@anchor{253} @section RM G.1.2(49): Complex Elementary Functions @@ -15744,7 +15771,7 @@ Followed. @geindex Accuracy requirements @node RM G 2 4 19 Accuracy Requirements,RM G 2 6 15 Complex Arithmetic Accuracy,RM G 1 2 49 Complex Elementary Functions,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-g-2-4-19-accuracy-requirements}@anchor{250} +@anchor{gnat_rm/implementation_advice rm-g-2-4-19-accuracy-requirements}@anchor{254} @section RM G.2.4(19): Accuracy Requirements @@ -15768,7 +15795,7 @@ Followed. @geindex complex arithmetic @node RM G 2 6 15 Complex Arithmetic Accuracy,RM H 6 15/2 Pragma Partition_Elaboration_Policy,RM G 2 4 19 Accuracy Requirements,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-g-2-6-15-complex-arithmetic-accuracy}@anchor{251} +@anchor{gnat_rm/implementation_advice rm-g-2-6-15-complex-arithmetic-accuracy}@anchor{255} @section RM G.2.6(15): Complex Arithmetic Accuracy @@ -15786,7 +15813,7 @@ Followed. @geindex Sequential elaboration policy @node RM H 6 15/2 Pragma Partition_Elaboration_Policy,,RM G 2 6 15 Complex Arithmetic Accuracy,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-h-6-15-2-pragma-partition-elaboration-policy}@anchor{252} +@anchor{gnat_rm/implementation_advice rm-h-6-15-2-pragma-partition-elaboration-policy}@anchor{256} @section RM H.6(15/2): Pragma Partition_Elaboration_Policy @@ -15801,7 +15828,7 @@ immediately terminated." Not followed. @node Implementation Defined Characteristics,Intrinsic Subprograms,Implementation Advice,Top -@anchor{gnat_rm/implementation_defined_characteristics implementation-defined-characteristics}@anchor{b}@anchor{gnat_rm/implementation_defined_characteristics doc}@anchor{253}@anchor{gnat_rm/implementation_defined_characteristics id1}@anchor{254} +@anchor{gnat_rm/implementation_defined_characteristics implementation-defined-characteristics}@anchor{b}@anchor{gnat_rm/implementation_defined_characteristics doc}@anchor{257}@anchor{gnat_rm/implementation_defined_characteristics id1}@anchor{258} @chapter Implementation Defined Characteristics @@ -16997,7 +17024,7 @@ When the @code{Pattern} parameter is not the null string, it is interpreted according to the syntax of regular expressions as defined in the @code{GNAT.Regexp} package. -See @ref{255,,GNAT.Regexp (g-regexp.ads)}. +See @ref{259,,GNAT.Regexp (g-regexp.ads)}. @itemize * @@ -18046,7 +18073,7 @@ H.4(27)." There are no restrictions on pragma @code{Restrictions}. @node Intrinsic Subprograms,Representation Clauses and Pragmas,Implementation Defined Characteristics,Top -@anchor{gnat_rm/intrinsic_subprograms doc}@anchor{256}@anchor{gnat_rm/intrinsic_subprograms intrinsic-subprograms}@anchor{c}@anchor{gnat_rm/intrinsic_subprograms id1}@anchor{257} +@anchor{gnat_rm/intrinsic_subprograms doc}@anchor{25a}@anchor{gnat_rm/intrinsic_subprograms intrinsic-subprograms}@anchor{c}@anchor{gnat_rm/intrinsic_subprograms id1}@anchor{25b} @chapter Intrinsic Subprograms @@ -18084,7 +18111,7 @@ Ada standard does not require Ada compilers to implement this feature. @end menu @node Intrinsic Operators,Compilation_ISO_Date,,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms id2}@anchor{258}@anchor{gnat_rm/intrinsic_subprograms intrinsic-operators}@anchor{259} +@anchor{gnat_rm/intrinsic_subprograms id2}@anchor{25c}@anchor{gnat_rm/intrinsic_subprograms intrinsic-operators}@anchor{25d} @section Intrinsic Operators @@ -18115,7 +18142,7 @@ It is also possible to specify such operators for private types, if the full views are appropriate arithmetic types. @node Compilation_ISO_Date,Compilation_Date,Intrinsic Operators,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms id3}@anchor{25a}@anchor{gnat_rm/intrinsic_subprograms compilation-iso-date}@anchor{25b} +@anchor{gnat_rm/intrinsic_subprograms id3}@anchor{25e}@anchor{gnat_rm/intrinsic_subprograms compilation-iso-date}@anchor{25f} @section Compilation_ISO_Date @@ -18129,7 +18156,7 @@ application program should simply call the function the current compilation (in local time format YYYY-MM-DD). @node Compilation_Date,Compilation_Time,Compilation_ISO_Date,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms compilation-date}@anchor{25c}@anchor{gnat_rm/intrinsic_subprograms id4}@anchor{25d} +@anchor{gnat_rm/intrinsic_subprograms compilation-date}@anchor{260}@anchor{gnat_rm/intrinsic_subprograms id4}@anchor{261} @section Compilation_Date @@ -18139,7 +18166,7 @@ Same as Compilation_ISO_Date, except the string is in the form MMM DD YYYY. @node Compilation_Time,Enclosing_Entity,Compilation_Date,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms compilation-time}@anchor{25e}@anchor{gnat_rm/intrinsic_subprograms id5}@anchor{25f} +@anchor{gnat_rm/intrinsic_subprograms compilation-time}@anchor{262}@anchor{gnat_rm/intrinsic_subprograms id5}@anchor{263} @section Compilation_Time @@ -18153,7 +18180,7 @@ application program should simply call the function the current compilation (in local time format HH:MM:SS). @node Enclosing_Entity,Exception_Information,Compilation_Time,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms id6}@anchor{260}@anchor{gnat_rm/intrinsic_subprograms enclosing-entity}@anchor{261} +@anchor{gnat_rm/intrinsic_subprograms id6}@anchor{264}@anchor{gnat_rm/intrinsic_subprograms enclosing-entity}@anchor{265} @section Enclosing_Entity @@ -18167,7 +18194,7 @@ application program should simply call the function the current subprogram, package, task, entry, or protected subprogram. @node Exception_Information,Exception_Message,Enclosing_Entity,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms id7}@anchor{262}@anchor{gnat_rm/intrinsic_subprograms exception-information}@anchor{263} +@anchor{gnat_rm/intrinsic_subprograms id7}@anchor{266}@anchor{gnat_rm/intrinsic_subprograms exception-information}@anchor{267} @section Exception_Information @@ -18181,7 +18208,7 @@ so an application program should simply call the function the exception information associated with the current exception. @node Exception_Message,Exception_Name,Exception_Information,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms exception-message}@anchor{264}@anchor{gnat_rm/intrinsic_subprograms id8}@anchor{265} +@anchor{gnat_rm/intrinsic_subprograms exception-message}@anchor{268}@anchor{gnat_rm/intrinsic_subprograms id8}@anchor{269} @section Exception_Message @@ -18195,7 +18222,7 @@ so an application program should simply call the function the message associated with the current exception. @node Exception_Name,File,Exception_Message,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms exception-name}@anchor{266}@anchor{gnat_rm/intrinsic_subprograms id9}@anchor{267} +@anchor{gnat_rm/intrinsic_subprograms exception-name}@anchor{26a}@anchor{gnat_rm/intrinsic_subprograms id9}@anchor{26b} @section Exception_Name @@ -18209,7 +18236,7 @@ so an application program should simply call the function the name of the current exception. @node File,Line,Exception_Name,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms id10}@anchor{268}@anchor{gnat_rm/intrinsic_subprograms file}@anchor{269} +@anchor{gnat_rm/intrinsic_subprograms id10}@anchor{26c}@anchor{gnat_rm/intrinsic_subprograms file}@anchor{26d} @section File @@ -18223,7 +18250,7 @@ application program should simply call the function file. @node Line,Shifts and Rotates,File,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms id11}@anchor{26a}@anchor{gnat_rm/intrinsic_subprograms line}@anchor{26b} +@anchor{gnat_rm/intrinsic_subprograms id11}@anchor{26e}@anchor{gnat_rm/intrinsic_subprograms line}@anchor{26f} @section Line @@ -18237,7 +18264,7 @@ application program should simply call the function source line. @node Shifts and Rotates,Source_Location,Line,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms shifts-and-rotates}@anchor{26c}@anchor{gnat_rm/intrinsic_subprograms id12}@anchor{26d} +@anchor{gnat_rm/intrinsic_subprograms shifts-and-rotates}@anchor{270}@anchor{gnat_rm/intrinsic_subprograms id12}@anchor{271} @section Shifts and Rotates @@ -18276,7 +18303,7 @@ the Provide_Shift_Operators pragma, which provides the function declarations and corresponding pragma Import's for all five shift functions. @node Source_Location,,Shifts and Rotates,Intrinsic Subprograms -@anchor{gnat_rm/intrinsic_subprograms source-location}@anchor{26e}@anchor{gnat_rm/intrinsic_subprograms id13}@anchor{26f} +@anchor{gnat_rm/intrinsic_subprograms source-location}@anchor{272}@anchor{gnat_rm/intrinsic_subprograms id13}@anchor{273} @section Source_Location @@ -18290,7 +18317,7 @@ application program should simply call the function source file location. @node Representation Clauses and Pragmas,Standard Library Routines,Intrinsic Subprograms,Top -@anchor{gnat_rm/representation_clauses_and_pragmas representation-clauses-and-pragmas}@anchor{d}@anchor{gnat_rm/representation_clauses_and_pragmas doc}@anchor{270}@anchor{gnat_rm/representation_clauses_and_pragmas id1}@anchor{271} +@anchor{gnat_rm/representation_clauses_and_pragmas representation-clauses-and-pragmas}@anchor{d}@anchor{gnat_rm/representation_clauses_and_pragmas doc}@anchor{274}@anchor{gnat_rm/representation_clauses_and_pragmas id1}@anchor{275} @chapter Representation Clauses and Pragmas @@ -18336,7 +18363,7 @@ and this section describes the additional capabilities provided. @end menu @node Alignment Clauses,Size Clauses,,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id2}@anchor{272}@anchor{gnat_rm/representation_clauses_and_pragmas alignment-clauses}@anchor{273} +@anchor{gnat_rm/representation_clauses_and_pragmas id2}@anchor{276}@anchor{gnat_rm/representation_clauses_and_pragmas alignment-clauses}@anchor{277} @section Alignment Clauses @@ -18356,7 +18383,7 @@ For elementary types, the alignment is the minimum of the actual size of objects of the type divided by @code{Storage_Unit}, and the maximum alignment supported by the target. (This maximum alignment is given by the GNAT-specific attribute -@code{Standard'Maximum_Alignment}; see @ref{18d,,Attribute Maximum_Alignment}.) +@code{Standard'Maximum_Alignment}; see @ref{191,,Attribute Maximum_Alignment}.) @geindex Maximum_Alignment attribute @@ -18465,7 +18492,7 @@ assumption is non-portable, and other compilers may choose different alignments for the subtype @code{RS}. @node Size Clauses,Storage_Size Clauses,Alignment Clauses,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id3}@anchor{274}@anchor{gnat_rm/representation_clauses_and_pragmas size-clauses}@anchor{275} +@anchor{gnat_rm/representation_clauses_and_pragmas id3}@anchor{278}@anchor{gnat_rm/representation_clauses_and_pragmas size-clauses}@anchor{279} @section Size Clauses @@ -18542,7 +18569,7 @@ if it is known that a Size value can be accommodated in an object of type Integer. @node Storage_Size Clauses,Size of Variant Record Objects,Size Clauses,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas storage-size-clauses}@anchor{276}@anchor{gnat_rm/representation_clauses_and_pragmas id4}@anchor{277} +@anchor{gnat_rm/representation_clauses_and_pragmas storage-size-clauses}@anchor{27a}@anchor{gnat_rm/representation_clauses_and_pragmas id4}@anchor{27b} @section Storage_Size Clauses @@ -18615,7 +18642,7 @@ Of course in practice, there will not be any explicit allocators in the case of such an access declaration. @node Size of Variant Record Objects,Biased Representation,Storage_Size Clauses,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id5}@anchor{278}@anchor{gnat_rm/representation_clauses_and_pragmas size-of-variant-record-objects}@anchor{279} +@anchor{gnat_rm/representation_clauses_and_pragmas id5}@anchor{27c}@anchor{gnat_rm/representation_clauses_and_pragmas size-of-variant-record-objects}@anchor{27d} @section Size of Variant Record Objects @@ -18725,7 +18752,7 @@ the maximum size, regardless of the current variant value, the variant value. @node Biased Representation,Value_Size and Object_Size Clauses,Size of Variant Record Objects,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id6}@anchor{27a}@anchor{gnat_rm/representation_clauses_and_pragmas biased-representation}@anchor{27b} +@anchor{gnat_rm/representation_clauses_and_pragmas id6}@anchor{27e}@anchor{gnat_rm/representation_clauses_and_pragmas biased-representation}@anchor{27f} @section Biased Representation @@ -18763,7 +18790,7 @@ biased representation can be used for all discrete types except for enumeration types for which a representation clause is given. @node Value_Size and Object_Size Clauses,Component_Size Clauses,Biased Representation,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id7}@anchor{27c}@anchor{gnat_rm/representation_clauses_and_pragmas value-size-and-object-size-clauses}@anchor{27d} +@anchor{gnat_rm/representation_clauses_and_pragmas id7}@anchor{280}@anchor{gnat_rm/representation_clauses_and_pragmas value-size-and-object-size-clauses}@anchor{281} @section Value_Size and Object_Size Clauses @@ -19079,7 +19106,7 @@ definition clause forces biased representation. This warning can be turned off using @code{-gnatw.B}. @node Component_Size Clauses,Bit_Order Clauses,Value_Size and Object_Size Clauses,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id8}@anchor{27e}@anchor{gnat_rm/representation_clauses_and_pragmas component-size-clauses}@anchor{27f} +@anchor{gnat_rm/representation_clauses_and_pragmas id8}@anchor{282}@anchor{gnat_rm/representation_clauses_and_pragmas component-size-clauses}@anchor{283} @section Component_Size Clauses @@ -19126,7 +19153,7 @@ and a pragma Pack for the same array type. if such duplicate clauses are given, the pragma Pack will be ignored. @node Bit_Order Clauses,Effect of Bit_Order on Byte Ordering,Component_Size Clauses,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas bit-order-clauses}@anchor{280}@anchor{gnat_rm/representation_clauses_and_pragmas id9}@anchor{281} +@anchor{gnat_rm/representation_clauses_and_pragmas bit-order-clauses}@anchor{284}@anchor{gnat_rm/representation_clauses_and_pragmas id9}@anchor{285} @section Bit_Order Clauses @@ -19232,7 +19259,7 @@ if desired. The following section contains additional details regarding the issue of byte ordering. @node Effect of Bit_Order on Byte Ordering,Pragma Pack for Arrays,Bit_Order Clauses,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id10}@anchor{282}@anchor{gnat_rm/representation_clauses_and_pragmas effect-of-bit-order-on-byte-ordering}@anchor{283} +@anchor{gnat_rm/representation_clauses_and_pragmas id10}@anchor{286}@anchor{gnat_rm/representation_clauses_and_pragmas effect-of-bit-order-on-byte-ordering}@anchor{287} @section Effect of Bit_Order on Byte Ordering @@ -19489,7 +19516,7 @@ to set the boolean constant @code{Master_Byte_First} in an appropriate manner. @node Pragma Pack for Arrays,Pragma Pack for Records,Effect of Bit_Order on Byte Ordering,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas pragma-pack-for-arrays}@anchor{284}@anchor{gnat_rm/representation_clauses_and_pragmas id11}@anchor{285} +@anchor{gnat_rm/representation_clauses_and_pragmas pragma-pack-for-arrays}@anchor{288}@anchor{gnat_rm/representation_clauses_and_pragmas id11}@anchor{289} @section Pragma Pack for Arrays @@ -19606,7 +19633,7 @@ Here 31-bit packing is achieved as required, and no warning is generated, since in this case the programmer intention is clear. @node Pragma Pack for Records,Record Representation Clauses,Pragma Pack for Arrays,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas pragma-pack-for-records}@anchor{286}@anchor{gnat_rm/representation_clauses_and_pragmas id12}@anchor{287} +@anchor{gnat_rm/representation_clauses_and_pragmas pragma-pack-for-records}@anchor{28a}@anchor{gnat_rm/representation_clauses_and_pragmas id12}@anchor{28b} @section Pragma Pack for Records @@ -19691,7 +19718,7 @@ the @code{L6} field is aligned to the next byte boundary, and takes an integral number of bytes, i.e., 72 bits. @node Record Representation Clauses,Handling of Records with Holes,Pragma Pack for Records,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id13}@anchor{288}@anchor{gnat_rm/representation_clauses_and_pragmas record-representation-clauses}@anchor{289} +@anchor{gnat_rm/representation_clauses_and_pragmas id13}@anchor{28c}@anchor{gnat_rm/representation_clauses_and_pragmas record-representation-clauses}@anchor{28d} @section Record Representation Clauses @@ -19769,7 +19796,7 @@ end record; @end example @node Handling of Records with Holes,Enumeration Clauses,Record Representation Clauses,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas handling-of-records-with-holes}@anchor{28a}@anchor{gnat_rm/representation_clauses_and_pragmas id14}@anchor{28b} +@anchor{gnat_rm/representation_clauses_and_pragmas handling-of-records-with-holes}@anchor{28e}@anchor{gnat_rm/representation_clauses_and_pragmas id14}@anchor{28f} @section Handling of Records with Holes @@ -19846,7 +19873,7 @@ for Hrec'Size use 64; @end example @node Enumeration Clauses,Address Clauses,Handling of Records with Holes,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas enumeration-clauses}@anchor{28c}@anchor{gnat_rm/representation_clauses_and_pragmas id15}@anchor{28d} +@anchor{gnat_rm/representation_clauses_and_pragmas enumeration-clauses}@anchor{290}@anchor{gnat_rm/representation_clauses_and_pragmas id15}@anchor{291} @section Enumeration Clauses @@ -19889,7 +19916,7 @@ the overhead of converting representation values to the corresponding positional values, (i.e., the value delivered by the @code{Pos} attribute). @node Address Clauses,Use of Address Clauses for Memory-Mapped I/O,Enumeration Clauses,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id16}@anchor{28e}@anchor{gnat_rm/representation_clauses_and_pragmas address-clauses}@anchor{28f} +@anchor{gnat_rm/representation_clauses_and_pragmas id16}@anchor{292}@anchor{gnat_rm/representation_clauses_and_pragmas address-clauses}@anchor{293} @section Address Clauses @@ -20218,7 +20245,7 @@ then the program compiles without the warning and when run will generate the output @code{X was not clobbered}. @node Use of Address Clauses for Memory-Mapped I/O,Effect of Convention on Representation,Address Clauses,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id17}@anchor{290}@anchor{gnat_rm/representation_clauses_and_pragmas use-of-address-clauses-for-memory-mapped-i-o}@anchor{291} +@anchor{gnat_rm/representation_clauses_and_pragmas id17}@anchor{294}@anchor{gnat_rm/representation_clauses_and_pragmas use-of-address-clauses-for-memory-mapped-i-o}@anchor{295} @section Use of Address Clauses for Memory-Mapped I/O @@ -20276,7 +20303,7 @@ provides the pragma @code{Volatile_Full_Access} which can be used in lieu of pragma @code{Atomic} and will give the additional guarantee. @node Effect of Convention on Representation,Conventions and Anonymous Access Types,Use of Address Clauses for Memory-Mapped I/O,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id18}@anchor{292}@anchor{gnat_rm/representation_clauses_and_pragmas effect-of-convention-on-representation}@anchor{293} +@anchor{gnat_rm/representation_clauses_and_pragmas id18}@anchor{296}@anchor{gnat_rm/representation_clauses_and_pragmas effect-of-convention-on-representation}@anchor{297} @section Effect of Convention on Representation @@ -20354,7 +20381,7 @@ when one of these values is read, any nonzero value is treated as True. @end itemize @node Conventions and Anonymous Access Types,Determining the Representations chosen by GNAT,Effect of Convention on Representation,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas conventions-and-anonymous-access-types}@anchor{294}@anchor{gnat_rm/representation_clauses_and_pragmas id19}@anchor{295} +@anchor{gnat_rm/representation_clauses_and_pragmas conventions-and-anonymous-access-types}@anchor{298}@anchor{gnat_rm/representation_clauses_and_pragmas id19}@anchor{299} @section Conventions and Anonymous Access Types @@ -20430,7 +20457,7 @@ package ConvComp is @end example @node Determining the Representations chosen by GNAT,,Conventions and Anonymous Access Types,Representation Clauses and Pragmas -@anchor{gnat_rm/representation_clauses_and_pragmas id20}@anchor{296}@anchor{gnat_rm/representation_clauses_and_pragmas determining-the-representations-chosen-by-gnat}@anchor{297} +@anchor{gnat_rm/representation_clauses_and_pragmas id20}@anchor{29a}@anchor{gnat_rm/representation_clauses_and_pragmas determining-the-representations-chosen-by-gnat}@anchor{29b} @section Determining the Representations chosen by GNAT @@ -20582,7 +20609,7 @@ generated by the compiler into the original source to fix and guarantee the actual representation to be used. @node Standard Library Routines,The Implementation of Standard I/O,Representation Clauses and Pragmas,Top -@anchor{gnat_rm/standard_library_routines standard-library-routines}@anchor{e}@anchor{gnat_rm/standard_library_routines doc}@anchor{298}@anchor{gnat_rm/standard_library_routines id1}@anchor{299} +@anchor{gnat_rm/standard_library_routines standard-library-routines}@anchor{e}@anchor{gnat_rm/standard_library_routines doc}@anchor{29c}@anchor{gnat_rm/standard_library_routines id1}@anchor{29d} @chapter Standard Library Routines @@ -21406,7 +21433,7 @@ For packages in Interfaces and System, all the RM defined packages are available in GNAT, see the Ada 2012 RM for full details. @node The Implementation of Standard I/O,The GNAT Library,Standard Library Routines,Top -@anchor{gnat_rm/the_implementation_of_standard_i_o the-implementation-of-standard-i-o}@anchor{f}@anchor{gnat_rm/the_implementation_of_standard_i_o doc}@anchor{29a}@anchor{gnat_rm/the_implementation_of_standard_i_o id1}@anchor{29b} +@anchor{gnat_rm/the_implementation_of_standard_i_o the-implementation-of-standard-i-o}@anchor{f}@anchor{gnat_rm/the_implementation_of_standard_i_o doc}@anchor{29e}@anchor{gnat_rm/the_implementation_of_standard_i_o id1}@anchor{29f} @chapter The Implementation of Standard I/O @@ -21458,7 +21485,7 @@ these additional facilities are also described in this chapter. @end menu @node Standard I/O Packages,FORM Strings,,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o standard-i-o-packages}@anchor{29c}@anchor{gnat_rm/the_implementation_of_standard_i_o id2}@anchor{29d} +@anchor{gnat_rm/the_implementation_of_standard_i_o standard-i-o-packages}@anchor{2a0}@anchor{gnat_rm/the_implementation_of_standard_i_o id2}@anchor{2a1} @section Standard I/O Packages @@ -21529,7 +21556,7 @@ flush the common I/O streams and in particular Standard_Output before elaborating the Ada code. @node FORM Strings,Direct_IO,Standard I/O Packages,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o form-strings}@anchor{29e}@anchor{gnat_rm/the_implementation_of_standard_i_o id3}@anchor{29f} +@anchor{gnat_rm/the_implementation_of_standard_i_o form-strings}@anchor{2a2}@anchor{gnat_rm/the_implementation_of_standard_i_o id3}@anchor{2a3} @section FORM Strings @@ -21555,7 +21582,7 @@ unrecognized keyword appears in a form string, it is silently ignored and not considered invalid. @node Direct_IO,Sequential_IO,FORM Strings,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o direct-io}@anchor{2a0}@anchor{gnat_rm/the_implementation_of_standard_i_o id4}@anchor{2a1} +@anchor{gnat_rm/the_implementation_of_standard_i_o direct-io}@anchor{2a4}@anchor{gnat_rm/the_implementation_of_standard_i_o id4}@anchor{2a5} @section Direct_IO @@ -21575,7 +21602,7 @@ There is no limit on the size of Direct_IO files, they are expanded as necessary to accommodate whatever records are written to the file. @node Sequential_IO,Text_IO,Direct_IO,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o sequential-io}@anchor{2a2}@anchor{gnat_rm/the_implementation_of_standard_i_o id5}@anchor{2a3} +@anchor{gnat_rm/the_implementation_of_standard_i_o sequential-io}@anchor{2a6}@anchor{gnat_rm/the_implementation_of_standard_i_o id5}@anchor{2a7} @section Sequential_IO @@ -21622,7 +21649,7 @@ using Stream_IO, and this is the preferred mechanism. In particular, the above program fragment rewritten to use Stream_IO will work correctly. @node Text_IO,Wide_Text_IO,Sequential_IO,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o id6}@anchor{2a4}@anchor{gnat_rm/the_implementation_of_standard_i_o text-io}@anchor{2a5} +@anchor{gnat_rm/the_implementation_of_standard_i_o id6}@anchor{2a8}@anchor{gnat_rm/the_implementation_of_standard_i_o text-io}@anchor{2a9} @section Text_IO @@ -21705,7 +21732,7 @@ the file. @end menu @node Stream Pointer Positioning,Reading and Writing Non-Regular Files,,Text_IO -@anchor{gnat_rm/the_implementation_of_standard_i_o id7}@anchor{2a6}@anchor{gnat_rm/the_implementation_of_standard_i_o stream-pointer-positioning}@anchor{2a7} +@anchor{gnat_rm/the_implementation_of_standard_i_o id7}@anchor{2aa}@anchor{gnat_rm/the_implementation_of_standard_i_o stream-pointer-positioning}@anchor{2ab} @subsection Stream Pointer Positioning @@ -21741,7 +21768,7 @@ between two Ada files, then the difference may be observable in some situations. @node Reading and Writing Non-Regular Files,Get_Immediate,Stream Pointer Positioning,Text_IO -@anchor{gnat_rm/the_implementation_of_standard_i_o reading-and-writing-non-regular-files}@anchor{2a8}@anchor{gnat_rm/the_implementation_of_standard_i_o id8}@anchor{2a9} +@anchor{gnat_rm/the_implementation_of_standard_i_o reading-and-writing-non-regular-files}@anchor{2ac}@anchor{gnat_rm/the_implementation_of_standard_i_o id8}@anchor{2ad} @subsection Reading and Writing Non-Regular Files @@ -21792,7 +21819,7 @@ to read data past that end of file indication, until another end of file indication is entered. @node Get_Immediate,Treating Text_IO Files as Streams,Reading and Writing Non-Regular Files,Text_IO -@anchor{gnat_rm/the_implementation_of_standard_i_o get-immediate}@anchor{2aa}@anchor{gnat_rm/the_implementation_of_standard_i_o id9}@anchor{2ab} +@anchor{gnat_rm/the_implementation_of_standard_i_o get-immediate}@anchor{2ae}@anchor{gnat_rm/the_implementation_of_standard_i_o id9}@anchor{2af} @subsection Get_Immediate @@ -21810,7 +21837,7 @@ possible), it is undefined whether the FF character will be treated as a page mark. @node Treating Text_IO Files as Streams,Text_IO Extensions,Get_Immediate,Text_IO -@anchor{gnat_rm/the_implementation_of_standard_i_o id10}@anchor{2ac}@anchor{gnat_rm/the_implementation_of_standard_i_o treating-text-io-files-as-streams}@anchor{2ad} +@anchor{gnat_rm/the_implementation_of_standard_i_o id10}@anchor{2b0}@anchor{gnat_rm/the_implementation_of_standard_i_o treating-text-io-files-as-streams}@anchor{2b1} @subsection Treating Text_IO Files as Streams @@ -21826,7 +21853,7 @@ skipped and the effect is similar to that described above for @code{Get_Immediate}. @node Text_IO Extensions,Text_IO Facilities for Unbounded Strings,Treating Text_IO Files as Streams,Text_IO -@anchor{gnat_rm/the_implementation_of_standard_i_o id11}@anchor{2ae}@anchor{gnat_rm/the_implementation_of_standard_i_o text-io-extensions}@anchor{2af} +@anchor{gnat_rm/the_implementation_of_standard_i_o id11}@anchor{2b2}@anchor{gnat_rm/the_implementation_of_standard_i_o text-io-extensions}@anchor{2b3} @subsection Text_IO Extensions @@ -21854,7 +21881,7 @@ the string is to be read. @end itemize @node Text_IO Facilities for Unbounded Strings,,Text_IO Extensions,Text_IO -@anchor{gnat_rm/the_implementation_of_standard_i_o text-io-facilities-for-unbounded-strings}@anchor{2b0}@anchor{gnat_rm/the_implementation_of_standard_i_o id12}@anchor{2b1} +@anchor{gnat_rm/the_implementation_of_standard_i_o text-io-facilities-for-unbounded-strings}@anchor{2b4}@anchor{gnat_rm/the_implementation_of_standard_i_o id12}@anchor{2b5} @subsection Text_IO Facilities for Unbounded Strings @@ -21902,7 +21929,7 @@ files @code{a-szuzti.ads} and @code{a-szuzti.adb} provides similar extended @code{Wide_Wide_Text_IO} functionality for unbounded wide wide strings. @node Wide_Text_IO,Wide_Wide_Text_IO,Text_IO,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o wide-text-io}@anchor{2b2}@anchor{gnat_rm/the_implementation_of_standard_i_o id13}@anchor{2b3} +@anchor{gnat_rm/the_implementation_of_standard_i_o wide-text-io}@anchor{2b6}@anchor{gnat_rm/the_implementation_of_standard_i_o id13}@anchor{2b7} @section Wide_Text_IO @@ -22149,12 +22176,12 @@ input also causes Constraint_Error to be raised. @end menu @node Stream Pointer Positioning<2>,Reading and Writing Non-Regular Files<2>,,Wide_Text_IO -@anchor{gnat_rm/the_implementation_of_standard_i_o stream-pointer-positioning-1}@anchor{2b4}@anchor{gnat_rm/the_implementation_of_standard_i_o id14}@anchor{2b5} +@anchor{gnat_rm/the_implementation_of_standard_i_o stream-pointer-positioning-1}@anchor{2b8}@anchor{gnat_rm/the_implementation_of_standard_i_o id14}@anchor{2b9} @subsection Stream Pointer Positioning @code{Ada.Wide_Text_IO} is similar to @code{Ada.Text_IO} in its handling -of stream pointer positioning (@ref{2a5,,Text_IO}). There is one additional +of stream pointer positioning (@ref{2a9,,Text_IO}). There is one additional case: If @code{Ada.Wide_Text_IO.Look_Ahead} reads a character outside the @@ -22173,7 +22200,7 @@ to a normal program using @code{Wide_Text_IO}. However, this discrepancy can be observed if the wide text file shares a stream with another file. @node Reading and Writing Non-Regular Files<2>,,Stream Pointer Positioning<2>,Wide_Text_IO -@anchor{gnat_rm/the_implementation_of_standard_i_o reading-and-writing-non-regular-files-1}@anchor{2b6}@anchor{gnat_rm/the_implementation_of_standard_i_o id15}@anchor{2b7} +@anchor{gnat_rm/the_implementation_of_standard_i_o reading-and-writing-non-regular-files-1}@anchor{2ba}@anchor{gnat_rm/the_implementation_of_standard_i_o id15}@anchor{2bb} @subsection Reading and Writing Non-Regular Files @@ -22184,7 +22211,7 @@ treated as data characters), and @code{End_Of_Page} always returns it is possible to read beyond an end of file. @node Wide_Wide_Text_IO,Stream_IO,Wide_Text_IO,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o id16}@anchor{2b8}@anchor{gnat_rm/the_implementation_of_standard_i_o wide-wide-text-io}@anchor{2b9} +@anchor{gnat_rm/the_implementation_of_standard_i_o id16}@anchor{2bc}@anchor{gnat_rm/the_implementation_of_standard_i_o wide-wide-text-io}@anchor{2bd} @section Wide_Wide_Text_IO @@ -22353,12 +22380,12 @@ input also causes Constraint_Error to be raised. @end menu @node Stream Pointer Positioning<3>,Reading and Writing Non-Regular Files<3>,,Wide_Wide_Text_IO -@anchor{gnat_rm/the_implementation_of_standard_i_o stream-pointer-positioning-2}@anchor{2ba}@anchor{gnat_rm/the_implementation_of_standard_i_o id17}@anchor{2bb} +@anchor{gnat_rm/the_implementation_of_standard_i_o stream-pointer-positioning-2}@anchor{2be}@anchor{gnat_rm/the_implementation_of_standard_i_o id17}@anchor{2bf} @subsection Stream Pointer Positioning @code{Ada.Wide_Wide_Text_IO} is similar to @code{Ada.Text_IO} in its handling -of stream pointer positioning (@ref{2a5,,Text_IO}). There is one additional +of stream pointer positioning (@ref{2a9,,Text_IO}). There is one additional case: If @code{Ada.Wide_Wide_Text_IO.Look_Ahead} reads a character outside the @@ -22377,7 +22404,7 @@ to a normal program using @code{Wide_Wide_Text_IO}. However, this discrepancy can be observed if the wide text file shares a stream with another file. @node Reading and Writing Non-Regular Files<3>,,Stream Pointer Positioning<3>,Wide_Wide_Text_IO -@anchor{gnat_rm/the_implementation_of_standard_i_o id18}@anchor{2bc}@anchor{gnat_rm/the_implementation_of_standard_i_o reading-and-writing-non-regular-files-2}@anchor{2bd} +@anchor{gnat_rm/the_implementation_of_standard_i_o id18}@anchor{2c0}@anchor{gnat_rm/the_implementation_of_standard_i_o reading-and-writing-non-regular-files-2}@anchor{2c1} @subsection Reading and Writing Non-Regular Files @@ -22388,7 +22415,7 @@ treated as data characters), and @code{End_Of_Page} always returns it is possible to read beyond an end of file. @node Stream_IO,Text Translation,Wide_Wide_Text_IO,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o id19}@anchor{2be}@anchor{gnat_rm/the_implementation_of_standard_i_o stream-io}@anchor{2bf} +@anchor{gnat_rm/the_implementation_of_standard_i_o id19}@anchor{2c2}@anchor{gnat_rm/the_implementation_of_standard_i_o stream-io}@anchor{2c3} @section Stream_IO @@ -22410,7 +22437,7 @@ manner described for stream attributes. @end itemize @node Text Translation,Shared Files,Stream_IO,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o id20}@anchor{2c0}@anchor{gnat_rm/the_implementation_of_standard_i_o text-translation}@anchor{2c1} +@anchor{gnat_rm/the_implementation_of_standard_i_o id20}@anchor{2c4}@anchor{gnat_rm/the_implementation_of_standard_i_o text-translation}@anchor{2c5} @section Text Translation @@ -22444,7 +22471,7 @@ mode. (corresponds to_O_U16TEXT). @end itemize @node Shared Files,Filenames encoding,Text Translation,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o id21}@anchor{2c2}@anchor{gnat_rm/the_implementation_of_standard_i_o shared-files}@anchor{2c3} +@anchor{gnat_rm/the_implementation_of_standard_i_o id21}@anchor{2c6}@anchor{gnat_rm/the_implementation_of_standard_i_o shared-files}@anchor{2c7} @section Shared Files @@ -22507,7 +22534,7 @@ heterogeneous input-output. Although this approach will work in GNAT if for this purpose (using the stream attributes) @node Filenames encoding,File content encoding,Shared Files,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o filenames-encoding}@anchor{2c4}@anchor{gnat_rm/the_implementation_of_standard_i_o id22}@anchor{2c5} +@anchor{gnat_rm/the_implementation_of_standard_i_o filenames-encoding}@anchor{2c8}@anchor{gnat_rm/the_implementation_of_standard_i_o id22}@anchor{2c9} @section Filenames encoding @@ -22547,7 +22574,7 @@ platform. On the other Operating Systems the run-time is supporting UTF-8 natively. @node File content encoding,Open Modes,Filenames encoding,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o file-content-encoding}@anchor{2c6}@anchor{gnat_rm/the_implementation_of_standard_i_o id23}@anchor{2c7} +@anchor{gnat_rm/the_implementation_of_standard_i_o file-content-encoding}@anchor{2ca}@anchor{gnat_rm/the_implementation_of_standard_i_o id23}@anchor{2cb} @section File content encoding @@ -22580,7 +22607,7 @@ Unicode 8-bit encoding This encoding is only supported on the Windows platform. @node Open Modes,Operations on C Streams,File content encoding,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o open-modes}@anchor{2c8}@anchor{gnat_rm/the_implementation_of_standard_i_o id24}@anchor{2c9} +@anchor{gnat_rm/the_implementation_of_standard_i_o open-modes}@anchor{2cc}@anchor{gnat_rm/the_implementation_of_standard_i_o id24}@anchor{2cd} @section Open Modes @@ -22683,7 +22710,7 @@ subsequently requires switching from reading to writing or vice-versa, then the file is reopened in @code{r+} mode to permit the required operation. @node Operations on C Streams,Interfacing to C Streams,Open Modes,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o operations-on-c-streams}@anchor{2ca}@anchor{gnat_rm/the_implementation_of_standard_i_o id25}@anchor{2cb} +@anchor{gnat_rm/the_implementation_of_standard_i_o operations-on-c-streams}@anchor{2ce}@anchor{gnat_rm/the_implementation_of_standard_i_o id25}@anchor{2cf} @section Operations on C Streams @@ -22843,7 +22870,7 @@ end Interfaces.C_Streams; @end example @node Interfacing to C Streams,,Operations on C Streams,The Implementation of Standard I/O -@anchor{gnat_rm/the_implementation_of_standard_i_o interfacing-to-c-streams}@anchor{2cc}@anchor{gnat_rm/the_implementation_of_standard_i_o id26}@anchor{2cd} +@anchor{gnat_rm/the_implementation_of_standard_i_o interfacing-to-c-streams}@anchor{2d0}@anchor{gnat_rm/the_implementation_of_standard_i_o id26}@anchor{2d1} @section Interfacing to C Streams @@ -22936,7 +22963,7 @@ imported from a C program, allowing an Ada file to operate on an existing C file. @node The GNAT Library,Interfacing to Other Languages,The Implementation of Standard I/O,Top -@anchor{gnat_rm/the_gnat_library the-gnat-library}@anchor{10}@anchor{gnat_rm/the_gnat_library doc}@anchor{2ce}@anchor{gnat_rm/the_gnat_library id1}@anchor{2cf} +@anchor{gnat_rm/the_gnat_library the-gnat-library}@anchor{10}@anchor{gnat_rm/the_gnat_library doc}@anchor{2d2}@anchor{gnat_rm/the_gnat_library id1}@anchor{2d3} @chapter The GNAT Library @@ -23129,7 +23156,7 @@ of GNAT, and will generate a warning message. @end menu @node Ada Characters Latin_9 a-chlat9 ads,Ada Characters Wide_Latin_1 a-cwila1 ads,,The GNAT Library -@anchor{gnat_rm/the_gnat_library id2}@anchor{2d0}@anchor{gnat_rm/the_gnat_library ada-characters-latin-9-a-chlat9-ads}@anchor{2d1} +@anchor{gnat_rm/the_gnat_library id2}@anchor{2d4}@anchor{gnat_rm/the_gnat_library ada-characters-latin-9-a-chlat9-ads}@anchor{2d5} @section @code{Ada.Characters.Latin_9} (@code{a-chlat9.ads}) @@ -23146,7 +23173,7 @@ is specifically authorized by the Ada Reference Manual (RM A.3.3(27)). @node Ada Characters Wide_Latin_1 a-cwila1 ads,Ada Characters Wide_Latin_9 a-cwila1 ads,Ada Characters Latin_9 a-chlat9 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-characters-wide-latin-1-a-cwila1-ads}@anchor{2d2}@anchor{gnat_rm/the_gnat_library id3}@anchor{2d3} +@anchor{gnat_rm/the_gnat_library ada-characters-wide-latin-1-a-cwila1-ads}@anchor{2d6}@anchor{gnat_rm/the_gnat_library id3}@anchor{2d7} @section @code{Ada.Characters.Wide_Latin_1} (@code{a-cwila1.ads}) @@ -23163,7 +23190,7 @@ is specifically authorized by the Ada Reference Manual (RM A.3.3(27)). @node Ada Characters Wide_Latin_9 a-cwila1 ads,Ada Characters Wide_Wide_Latin_1 a-chzla1 ads,Ada Characters Wide_Latin_1 a-cwila1 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id4}@anchor{2d4}@anchor{gnat_rm/the_gnat_library ada-characters-wide-latin-9-a-cwila1-ads}@anchor{2d5} +@anchor{gnat_rm/the_gnat_library id4}@anchor{2d8}@anchor{gnat_rm/the_gnat_library ada-characters-wide-latin-9-a-cwila1-ads}@anchor{2d9} @section @code{Ada.Characters.Wide_Latin_9} (@code{a-cwila1.ads}) @@ -23180,7 +23207,7 @@ is specifically authorized by the Ada Reference Manual (RM A.3.3(27)). @node Ada Characters Wide_Wide_Latin_1 a-chzla1 ads,Ada Characters Wide_Wide_Latin_9 a-chzla9 ads,Ada Characters Wide_Latin_9 a-cwila1 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-characters-wide-wide-latin-1-a-chzla1-ads}@anchor{2d6}@anchor{gnat_rm/the_gnat_library id5}@anchor{2d7} +@anchor{gnat_rm/the_gnat_library ada-characters-wide-wide-latin-1-a-chzla1-ads}@anchor{2da}@anchor{gnat_rm/the_gnat_library id5}@anchor{2db} @section @code{Ada.Characters.Wide_Wide_Latin_1} (@code{a-chzla1.ads}) @@ -23197,7 +23224,7 @@ is specifically authorized by the Ada Reference Manual (RM A.3.3(27)). @node Ada Characters Wide_Wide_Latin_9 a-chzla9 ads,Ada Containers Formal_Doubly_Linked_Lists a-cfdlli ads,Ada Characters Wide_Wide_Latin_1 a-chzla1 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-characters-wide-wide-latin-9-a-chzla9-ads}@anchor{2d8}@anchor{gnat_rm/the_gnat_library id6}@anchor{2d9} +@anchor{gnat_rm/the_gnat_library ada-characters-wide-wide-latin-9-a-chzla9-ads}@anchor{2dc}@anchor{gnat_rm/the_gnat_library id6}@anchor{2dd} @section @code{Ada.Characters.Wide_Wide_Latin_9} (@code{a-chzla9.ads}) @@ -23214,7 +23241,7 @@ is specifically authorized by the Ada Reference Manual (RM A.3.3(27)). @node Ada Containers Formal_Doubly_Linked_Lists a-cfdlli ads,Ada Containers Formal_Hashed_Maps a-cfhama ads,Ada Characters Wide_Wide_Latin_9 a-chzla9 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id7}@anchor{2da}@anchor{gnat_rm/the_gnat_library ada-containers-formal-doubly-linked-lists-a-cfdlli-ads}@anchor{2db} +@anchor{gnat_rm/the_gnat_library id7}@anchor{2de}@anchor{gnat_rm/the_gnat_library ada-containers-formal-doubly-linked-lists-a-cfdlli-ads}@anchor{2df} @section @code{Ada.Containers.Formal_Doubly_Linked_Lists} (@code{a-cfdlli.ads}) @@ -23233,7 +23260,7 @@ efficient version than the one defined in the standard. In particular it does not have the complex overhead required to detect cursor tampering. @node Ada Containers Formal_Hashed_Maps a-cfhama ads,Ada Containers Formal_Hashed_Sets a-cfhase ads,Ada Containers Formal_Doubly_Linked_Lists a-cfdlli ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id8}@anchor{2dc}@anchor{gnat_rm/the_gnat_library ada-containers-formal-hashed-maps-a-cfhama-ads}@anchor{2dd} +@anchor{gnat_rm/the_gnat_library id8}@anchor{2e0}@anchor{gnat_rm/the_gnat_library ada-containers-formal-hashed-maps-a-cfhama-ads}@anchor{2e1} @section @code{Ada.Containers.Formal_Hashed_Maps} (@code{a-cfhama.ads}) @@ -23252,7 +23279,7 @@ efficient version than the one defined in the standard. In particular it does not have the complex overhead required to detect cursor tampering. @node Ada Containers Formal_Hashed_Sets a-cfhase ads,Ada Containers Formal_Ordered_Maps a-cforma ads,Ada Containers Formal_Hashed_Maps a-cfhama ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id9}@anchor{2de}@anchor{gnat_rm/the_gnat_library ada-containers-formal-hashed-sets-a-cfhase-ads}@anchor{2df} +@anchor{gnat_rm/the_gnat_library id9}@anchor{2e2}@anchor{gnat_rm/the_gnat_library ada-containers-formal-hashed-sets-a-cfhase-ads}@anchor{2e3} @section @code{Ada.Containers.Formal_Hashed_Sets} (@code{a-cfhase.ads}) @@ -23271,7 +23298,7 @@ efficient version than the one defined in the standard. In particular it does not have the complex overhead required to detect cursor tampering. @node Ada Containers Formal_Ordered_Maps a-cforma ads,Ada Containers Formal_Ordered_Sets a-cforse ads,Ada Containers Formal_Hashed_Sets a-cfhase ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id10}@anchor{2e0}@anchor{gnat_rm/the_gnat_library ada-containers-formal-ordered-maps-a-cforma-ads}@anchor{2e1} +@anchor{gnat_rm/the_gnat_library id10}@anchor{2e4}@anchor{gnat_rm/the_gnat_library ada-containers-formal-ordered-maps-a-cforma-ads}@anchor{2e5} @section @code{Ada.Containers.Formal_Ordered_Maps} (@code{a-cforma.ads}) @@ -23290,7 +23317,7 @@ efficient version than the one defined in the standard. In particular it does not have the complex overhead required to detect cursor tampering. @node Ada Containers Formal_Ordered_Sets a-cforse ads,Ada Containers Formal_Vectors a-cofove ads,Ada Containers Formal_Ordered_Maps a-cforma ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-containers-formal-ordered-sets-a-cforse-ads}@anchor{2e2}@anchor{gnat_rm/the_gnat_library id11}@anchor{2e3} +@anchor{gnat_rm/the_gnat_library ada-containers-formal-ordered-sets-a-cforse-ads}@anchor{2e6}@anchor{gnat_rm/the_gnat_library id11}@anchor{2e7} @section @code{Ada.Containers.Formal_Ordered_Sets} (@code{a-cforse.ads}) @@ -23309,7 +23336,7 @@ efficient version than the one defined in the standard. In particular it does not have the complex overhead required to detect cursor tampering. @node Ada Containers Formal_Vectors a-cofove ads,Ada Containers Formal_Indefinite_Vectors a-cfinve ads,Ada Containers Formal_Ordered_Sets a-cforse ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id12}@anchor{2e4}@anchor{gnat_rm/the_gnat_library ada-containers-formal-vectors-a-cofove-ads}@anchor{2e5} +@anchor{gnat_rm/the_gnat_library id12}@anchor{2e8}@anchor{gnat_rm/the_gnat_library ada-containers-formal-vectors-a-cofove-ads}@anchor{2e9} @section @code{Ada.Containers.Formal_Vectors} (@code{a-cofove.ads}) @@ -23328,7 +23355,7 @@ efficient version than the one defined in the standard. In particular it does not have the complex overhead required to detect cursor tampering. @node Ada Containers Formal_Indefinite_Vectors a-cfinve ads,Ada Containers Functional_Vectors a-cofuve ads,Ada Containers Formal_Vectors a-cofove ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id13}@anchor{2e6}@anchor{gnat_rm/the_gnat_library ada-containers-formal-indefinite-vectors-a-cfinve-ads}@anchor{2e7} +@anchor{gnat_rm/the_gnat_library id13}@anchor{2ea}@anchor{gnat_rm/the_gnat_library ada-containers-formal-indefinite-vectors-a-cfinve-ads}@anchor{2eb} @section @code{Ada.Containers.Formal_Indefinite_Vectors} (@code{a-cfinve.ads}) @@ -23347,7 +23374,7 @@ efficient version than the one defined in the standard. In particular it does not have the complex overhead required to detect cursor tampering. @node Ada Containers Functional_Vectors a-cofuve ads,Ada Containers Functional_Sets a-cofuse ads,Ada Containers Formal_Indefinite_Vectors a-cfinve ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id14}@anchor{2e8}@anchor{gnat_rm/the_gnat_library ada-containers-functional-vectors-a-cofuve-ads}@anchor{2e9} +@anchor{gnat_rm/the_gnat_library id14}@anchor{2ec}@anchor{gnat_rm/the_gnat_library ada-containers-functional-vectors-a-cofuve-ads}@anchor{2ed} @section @code{Ada.Containers.Functional_Vectors} (@code{a-cofuve.ads}) @@ -23369,7 +23396,7 @@ and annotations, so that they can be removed from the final executable. The specification of this unit is compatible with SPARK 2014. @node Ada Containers Functional_Sets a-cofuse ads,Ada Containers Functional_Maps a-cofuma ads,Ada Containers Functional_Vectors a-cofuve ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-containers-functional-sets-a-cofuse-ads}@anchor{2ea}@anchor{gnat_rm/the_gnat_library id15}@anchor{2eb} +@anchor{gnat_rm/the_gnat_library ada-containers-functional-sets-a-cofuse-ads}@anchor{2ee}@anchor{gnat_rm/the_gnat_library id15}@anchor{2ef} @section @code{Ada.Containers.Functional_Sets} (@code{a-cofuse.ads}) @@ -23391,7 +23418,7 @@ and annotations, so that they can be removed from the final executable. The specification of this unit is compatible with SPARK 2014. @node Ada Containers Functional_Maps a-cofuma ads,Ada Containers Bounded_Holders a-coboho ads,Ada Containers Functional_Sets a-cofuse ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id16}@anchor{2ec}@anchor{gnat_rm/the_gnat_library ada-containers-functional-maps-a-cofuma-ads}@anchor{2ed} +@anchor{gnat_rm/the_gnat_library id16}@anchor{2f0}@anchor{gnat_rm/the_gnat_library ada-containers-functional-maps-a-cofuma-ads}@anchor{2f1} @section @code{Ada.Containers.Functional_Maps} (@code{a-cofuma.ads}) @@ -23413,7 +23440,7 @@ and annotations, so that they can be removed from the final executable. The specification of this unit is compatible with SPARK 2014. @node Ada Containers Bounded_Holders a-coboho ads,Ada Command_Line Environment a-colien ads,Ada Containers Functional_Maps a-cofuma ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-containers-bounded-holders-a-coboho-ads}@anchor{2ee}@anchor{gnat_rm/the_gnat_library id17}@anchor{2ef} +@anchor{gnat_rm/the_gnat_library ada-containers-bounded-holders-a-coboho-ads}@anchor{2f2}@anchor{gnat_rm/the_gnat_library id17}@anchor{2f3} @section @code{Ada.Containers.Bounded_Holders} (@code{a-coboho.ads}) @@ -23425,7 +23452,7 @@ This child of @code{Ada.Containers} defines a modified version of Indefinite_Holders that avoids heap allocation. @node Ada Command_Line Environment a-colien ads,Ada Command_Line Remove a-colire ads,Ada Containers Bounded_Holders a-coboho ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-command-line-environment-a-colien-ads}@anchor{2f0}@anchor{gnat_rm/the_gnat_library id18}@anchor{2f1} +@anchor{gnat_rm/the_gnat_library ada-command-line-environment-a-colien-ads}@anchor{2f4}@anchor{gnat_rm/the_gnat_library id18}@anchor{2f5} @section @code{Ada.Command_Line.Environment} (@code{a-colien.ads}) @@ -23438,7 +23465,7 @@ provides a mechanism for obtaining environment values on systems where this concept makes sense. @node Ada Command_Line Remove a-colire ads,Ada Command_Line Response_File a-clrefi ads,Ada Command_Line Environment a-colien ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id19}@anchor{2f2}@anchor{gnat_rm/the_gnat_library ada-command-line-remove-a-colire-ads}@anchor{2f3} +@anchor{gnat_rm/the_gnat_library id19}@anchor{2f6}@anchor{gnat_rm/the_gnat_library ada-command-line-remove-a-colire-ads}@anchor{2f7} @section @code{Ada.Command_Line.Remove} (@code{a-colire.ads}) @@ -23456,7 +23483,7 @@ to further calls on the subprograms in @code{Ada.Command_Line} will not see the removed argument. @node Ada Command_Line Response_File a-clrefi ads,Ada Direct_IO C_Streams a-diocst ads,Ada Command_Line Remove a-colire ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id20}@anchor{2f4}@anchor{gnat_rm/the_gnat_library ada-command-line-response-file-a-clrefi-ads}@anchor{2f5} +@anchor{gnat_rm/the_gnat_library id20}@anchor{2f8}@anchor{gnat_rm/the_gnat_library ada-command-line-response-file-a-clrefi-ads}@anchor{2f9} @section @code{Ada.Command_Line.Response_File} (@code{a-clrefi.ads}) @@ -23476,7 +23503,7 @@ Using a response file allow passing a set of arguments to an executable longer than the maximum allowed by the system on the command line. @node Ada Direct_IO C_Streams a-diocst ads,Ada Exceptions Is_Null_Occurrence a-einuoc ads,Ada Command_Line Response_File a-clrefi ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id21}@anchor{2f6}@anchor{gnat_rm/the_gnat_library ada-direct-io-c-streams-a-diocst-ads}@anchor{2f7} +@anchor{gnat_rm/the_gnat_library id21}@anchor{2fa}@anchor{gnat_rm/the_gnat_library ada-direct-io-c-streams-a-diocst-ads}@anchor{2fb} @section @code{Ada.Direct_IO.C_Streams} (@code{a-diocst.ads}) @@ -23491,7 +23518,7 @@ extracted from a file opened on the Ada side, and an Ada file can be constructed from a stream opened on the C side. @node Ada Exceptions Is_Null_Occurrence a-einuoc ads,Ada Exceptions Last_Chance_Handler a-elchha ads,Ada Direct_IO C_Streams a-diocst ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id22}@anchor{2f8}@anchor{gnat_rm/the_gnat_library ada-exceptions-is-null-occurrence-a-einuoc-ads}@anchor{2f9} +@anchor{gnat_rm/the_gnat_library id22}@anchor{2fc}@anchor{gnat_rm/the_gnat_library ada-exceptions-is-null-occurrence-a-einuoc-ads}@anchor{2fd} @section @code{Ada.Exceptions.Is_Null_Occurrence} (@code{a-einuoc.ads}) @@ -23505,7 +23532,7 @@ exception occurrence (@code{Null_Occurrence}) without raising an exception. @node Ada Exceptions Last_Chance_Handler a-elchha ads,Ada Exceptions Traceback a-exctra ads,Ada Exceptions Is_Null_Occurrence a-einuoc ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id23}@anchor{2fa}@anchor{gnat_rm/the_gnat_library ada-exceptions-last-chance-handler-a-elchha-ads}@anchor{2fb} +@anchor{gnat_rm/the_gnat_library id23}@anchor{2fe}@anchor{gnat_rm/the_gnat_library ada-exceptions-last-chance-handler-a-elchha-ads}@anchor{2ff} @section @code{Ada.Exceptions.Last_Chance_Handler} (@code{a-elchha.ads}) @@ -23519,7 +23546,7 @@ exceptions (hence the name last chance), and perform clean ups before terminating the program. Note that this subprogram never returns. @node Ada Exceptions Traceback a-exctra ads,Ada Sequential_IO C_Streams a-siocst ads,Ada Exceptions Last_Chance_Handler a-elchha ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-exceptions-traceback-a-exctra-ads}@anchor{2fc}@anchor{gnat_rm/the_gnat_library id24}@anchor{2fd} +@anchor{gnat_rm/the_gnat_library ada-exceptions-traceback-a-exctra-ads}@anchor{300}@anchor{gnat_rm/the_gnat_library id24}@anchor{301} @section @code{Ada.Exceptions.Traceback} (@code{a-exctra.ads}) @@ -23532,7 +23559,7 @@ give a traceback array of addresses based on an exception occurrence. @node Ada Sequential_IO C_Streams a-siocst ads,Ada Streams Stream_IO C_Streams a-ssicst ads,Ada Exceptions Traceback a-exctra ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-sequential-io-c-streams-a-siocst-ads}@anchor{2fe}@anchor{gnat_rm/the_gnat_library id25}@anchor{2ff} +@anchor{gnat_rm/the_gnat_library ada-sequential-io-c-streams-a-siocst-ads}@anchor{302}@anchor{gnat_rm/the_gnat_library id25}@anchor{303} @section @code{Ada.Sequential_IO.C_Streams} (@code{a-siocst.ads}) @@ -23547,7 +23574,7 @@ extracted from a file opened on the Ada side, and an Ada file can be constructed from a stream opened on the C side. @node Ada Streams Stream_IO C_Streams a-ssicst ads,Ada Strings Unbounded Text_IO a-suteio ads,Ada Sequential_IO C_Streams a-siocst ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id26}@anchor{300}@anchor{gnat_rm/the_gnat_library ada-streams-stream-io-c-streams-a-ssicst-ads}@anchor{301} +@anchor{gnat_rm/the_gnat_library id26}@anchor{304}@anchor{gnat_rm/the_gnat_library ada-streams-stream-io-c-streams-a-ssicst-ads}@anchor{305} @section @code{Ada.Streams.Stream_IO.C_Streams} (@code{a-ssicst.ads}) @@ -23562,7 +23589,7 @@ extracted from a file opened on the Ada side, and an Ada file can be constructed from a stream opened on the C side. @node Ada Strings Unbounded Text_IO a-suteio ads,Ada Strings Wide_Unbounded Wide_Text_IO a-swuwti ads,Ada Streams Stream_IO C_Streams a-ssicst ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-strings-unbounded-text-io-a-suteio-ads}@anchor{302}@anchor{gnat_rm/the_gnat_library id27}@anchor{303} +@anchor{gnat_rm/the_gnat_library ada-strings-unbounded-text-io-a-suteio-ads}@anchor{306}@anchor{gnat_rm/the_gnat_library id27}@anchor{307} @section @code{Ada.Strings.Unbounded.Text_IO} (@code{a-suteio.ads}) @@ -23579,7 +23606,7 @@ strings, avoiding the necessity for an intermediate operation with ordinary strings. @node Ada Strings Wide_Unbounded Wide_Text_IO a-swuwti ads,Ada Strings Wide_Wide_Unbounded Wide_Wide_Text_IO a-szuzti ads,Ada Strings Unbounded Text_IO a-suteio ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id28}@anchor{304}@anchor{gnat_rm/the_gnat_library ada-strings-wide-unbounded-wide-text-io-a-swuwti-ads}@anchor{305} +@anchor{gnat_rm/the_gnat_library id28}@anchor{308}@anchor{gnat_rm/the_gnat_library ada-strings-wide-unbounded-wide-text-io-a-swuwti-ads}@anchor{309} @section @code{Ada.Strings.Wide_Unbounded.Wide_Text_IO} (@code{a-swuwti.ads}) @@ -23596,7 +23623,7 @@ wide strings, avoiding the necessity for an intermediate operation with ordinary wide strings. @node Ada Strings Wide_Wide_Unbounded Wide_Wide_Text_IO a-szuzti ads,Ada Text_IO C_Streams a-tiocst ads,Ada Strings Wide_Unbounded Wide_Text_IO a-swuwti ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id29}@anchor{306}@anchor{gnat_rm/the_gnat_library ada-strings-wide-wide-unbounded-wide-wide-text-io-a-szuzti-ads}@anchor{307} +@anchor{gnat_rm/the_gnat_library id29}@anchor{30a}@anchor{gnat_rm/the_gnat_library ada-strings-wide-wide-unbounded-wide-wide-text-io-a-szuzti-ads}@anchor{30b} @section @code{Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO} (@code{a-szuzti.ads}) @@ -23613,7 +23640,7 @@ wide wide strings, avoiding the necessity for an intermediate operation with ordinary wide wide strings. @node Ada Text_IO C_Streams a-tiocst ads,Ada Text_IO Reset_Standard_Files a-tirsfi ads,Ada Strings Wide_Wide_Unbounded Wide_Wide_Text_IO a-szuzti ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-text-io-c-streams-a-tiocst-ads}@anchor{308}@anchor{gnat_rm/the_gnat_library id30}@anchor{309} +@anchor{gnat_rm/the_gnat_library ada-text-io-c-streams-a-tiocst-ads}@anchor{30c}@anchor{gnat_rm/the_gnat_library id30}@anchor{30d} @section @code{Ada.Text_IO.C_Streams} (@code{a-tiocst.ads}) @@ -23628,7 +23655,7 @@ extracted from a file opened on the Ada side, and an Ada file can be constructed from a stream opened on the C side. @node Ada Text_IO Reset_Standard_Files a-tirsfi ads,Ada Wide_Characters Unicode a-wichun ads,Ada Text_IO C_Streams a-tiocst ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-text-io-reset-standard-files-a-tirsfi-ads}@anchor{30a}@anchor{gnat_rm/the_gnat_library id31}@anchor{30b} +@anchor{gnat_rm/the_gnat_library ada-text-io-reset-standard-files-a-tirsfi-ads}@anchor{30e}@anchor{gnat_rm/the_gnat_library id31}@anchor{30f} @section @code{Ada.Text_IO.Reset_Standard_Files} (@code{a-tirsfi.ads}) @@ -23643,7 +23670,7 @@ execution (for example a standard input file may be redefined to be interactive). @node Ada Wide_Characters Unicode a-wichun ads,Ada Wide_Text_IO C_Streams a-wtcstr ads,Ada Text_IO Reset_Standard_Files a-tirsfi ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id32}@anchor{30c}@anchor{gnat_rm/the_gnat_library ada-wide-characters-unicode-a-wichun-ads}@anchor{30d} +@anchor{gnat_rm/the_gnat_library id32}@anchor{310}@anchor{gnat_rm/the_gnat_library ada-wide-characters-unicode-a-wichun-ads}@anchor{311} @section @code{Ada.Wide_Characters.Unicode} (@code{a-wichun.ads}) @@ -23656,7 +23683,7 @@ This package provides subprograms that allow categorization of Wide_Character values according to Unicode categories. @node Ada Wide_Text_IO C_Streams a-wtcstr ads,Ada Wide_Text_IO Reset_Standard_Files a-wrstfi ads,Ada Wide_Characters Unicode a-wichun ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-wide-text-io-c-streams-a-wtcstr-ads}@anchor{30e}@anchor{gnat_rm/the_gnat_library id33}@anchor{30f} +@anchor{gnat_rm/the_gnat_library ada-wide-text-io-c-streams-a-wtcstr-ads}@anchor{312}@anchor{gnat_rm/the_gnat_library id33}@anchor{313} @section @code{Ada.Wide_Text_IO.C_Streams} (@code{a-wtcstr.ads}) @@ -23671,7 +23698,7 @@ extracted from a file opened on the Ada side, and an Ada file can be constructed from a stream opened on the C side. @node Ada Wide_Text_IO Reset_Standard_Files a-wrstfi ads,Ada Wide_Wide_Characters Unicode a-zchuni ads,Ada Wide_Text_IO C_Streams a-wtcstr ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library ada-wide-text-io-reset-standard-files-a-wrstfi-ads}@anchor{310}@anchor{gnat_rm/the_gnat_library id34}@anchor{311} +@anchor{gnat_rm/the_gnat_library ada-wide-text-io-reset-standard-files-a-wrstfi-ads}@anchor{314}@anchor{gnat_rm/the_gnat_library id34}@anchor{315} @section @code{Ada.Wide_Text_IO.Reset_Standard_Files} (@code{a-wrstfi.ads}) @@ -23686,7 +23713,7 @@ execution (for example a standard input file may be redefined to be interactive). @node Ada Wide_Wide_Characters Unicode a-zchuni ads,Ada Wide_Wide_Text_IO C_Streams a-ztcstr ads,Ada Wide_Text_IO Reset_Standard_Files a-wrstfi ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id35}@anchor{312}@anchor{gnat_rm/the_gnat_library ada-wide-wide-characters-unicode-a-zchuni-ads}@anchor{313} +@anchor{gnat_rm/the_gnat_library id35}@anchor{316}@anchor{gnat_rm/the_gnat_library ada-wide-wide-characters-unicode-a-zchuni-ads}@anchor{317} @section @code{Ada.Wide_Wide_Characters.Unicode} (@code{a-zchuni.ads}) @@ -23699,7 +23726,7 @@ This package provides subprograms that allow categorization of Wide_Wide_Character values according to Unicode categories. @node Ada Wide_Wide_Text_IO C_Streams a-ztcstr ads,Ada Wide_Wide_Text_IO Reset_Standard_Files a-zrstfi ads,Ada Wide_Wide_Characters Unicode a-zchuni ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id36}@anchor{314}@anchor{gnat_rm/the_gnat_library ada-wide-wide-text-io-c-streams-a-ztcstr-ads}@anchor{315} +@anchor{gnat_rm/the_gnat_library id36}@anchor{318}@anchor{gnat_rm/the_gnat_library ada-wide-wide-text-io-c-streams-a-ztcstr-ads}@anchor{319} @section @code{Ada.Wide_Wide_Text_IO.C_Streams} (@code{a-ztcstr.ads}) @@ -23714,7 +23741,7 @@ extracted from a file opened on the Ada side, and an Ada file can be constructed from a stream opened on the C side. @node Ada Wide_Wide_Text_IO Reset_Standard_Files a-zrstfi ads,GNAT Altivec g-altive ads,Ada Wide_Wide_Text_IO C_Streams a-ztcstr ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id37}@anchor{316}@anchor{gnat_rm/the_gnat_library ada-wide-wide-text-io-reset-standard-files-a-zrstfi-ads}@anchor{317} +@anchor{gnat_rm/the_gnat_library id37}@anchor{31a}@anchor{gnat_rm/the_gnat_library ada-wide-wide-text-io-reset-standard-files-a-zrstfi-ads}@anchor{31b} @section @code{Ada.Wide_Wide_Text_IO.Reset_Standard_Files} (@code{a-zrstfi.ads}) @@ -23729,7 +23756,7 @@ change during execution (for example a standard input file may be redefined to be interactive). @node GNAT Altivec g-altive ads,GNAT Altivec Conversions g-altcon ads,Ada Wide_Wide_Text_IO Reset_Standard_Files a-zrstfi ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-altivec-g-altive-ads}@anchor{318}@anchor{gnat_rm/the_gnat_library id38}@anchor{319} +@anchor{gnat_rm/the_gnat_library gnat-altivec-g-altive-ads}@anchor{31c}@anchor{gnat_rm/the_gnat_library id38}@anchor{31d} @section @code{GNAT.Altivec} (@code{g-altive.ads}) @@ -23742,7 +23769,7 @@ definitions of constants and types common to all the versions of the binding. @node GNAT Altivec Conversions g-altcon ads,GNAT Altivec Vector_Operations g-alveop ads,GNAT Altivec g-altive ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-altivec-conversions-g-altcon-ads}@anchor{31a}@anchor{gnat_rm/the_gnat_library id39}@anchor{31b} +@anchor{gnat_rm/the_gnat_library gnat-altivec-conversions-g-altcon-ads}@anchor{31e}@anchor{gnat_rm/the_gnat_library id39}@anchor{31f} @section @code{GNAT.Altivec.Conversions} (@code{g-altcon.ads}) @@ -23753,7 +23780,7 @@ binding. This package provides the Vector/View conversion routines. @node GNAT Altivec Vector_Operations g-alveop ads,GNAT Altivec Vector_Types g-alvety ads,GNAT Altivec Conversions g-altcon ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-altivec-vector-operations-g-alveop-ads}@anchor{31c}@anchor{gnat_rm/the_gnat_library id40}@anchor{31d} +@anchor{gnat_rm/the_gnat_library gnat-altivec-vector-operations-g-alveop-ads}@anchor{320}@anchor{gnat_rm/the_gnat_library id40}@anchor{321} @section @code{GNAT.Altivec.Vector_Operations} (@code{g-alveop.ads}) @@ -23767,7 +23794,7 @@ library. The hard binding is provided as a separate package. This unit is common to both bindings. @node GNAT Altivec Vector_Types g-alvety ads,GNAT Altivec Vector_Views g-alvevi ads,GNAT Altivec Vector_Operations g-alveop ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-altivec-vector-types-g-alvety-ads}@anchor{31e}@anchor{gnat_rm/the_gnat_library id41}@anchor{31f} +@anchor{gnat_rm/the_gnat_library gnat-altivec-vector-types-g-alvety-ads}@anchor{322}@anchor{gnat_rm/the_gnat_library id41}@anchor{323} @section @code{GNAT.Altivec.Vector_Types} (@code{g-alvety.ads}) @@ -23779,7 +23806,7 @@ This package exposes the various vector types part of the Ada binding to AltiVec facilities. @node GNAT Altivec Vector_Views g-alvevi ads,GNAT Array_Split g-arrspl ads,GNAT Altivec Vector_Types g-alvety ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-altivec-vector-views-g-alvevi-ads}@anchor{320}@anchor{gnat_rm/the_gnat_library id42}@anchor{321} +@anchor{gnat_rm/the_gnat_library gnat-altivec-vector-views-g-alvevi-ads}@anchor{324}@anchor{gnat_rm/the_gnat_library id42}@anchor{325} @section @code{GNAT.Altivec.Vector_Views} (@code{g-alvevi.ads}) @@ -23794,7 +23821,7 @@ vector elements and provides a simple way to initialize vector objects. @node GNAT Array_Split g-arrspl ads,GNAT AWK g-awk ads,GNAT Altivec Vector_Views g-alvevi ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-array-split-g-arrspl-ads}@anchor{322}@anchor{gnat_rm/the_gnat_library id43}@anchor{323} +@anchor{gnat_rm/the_gnat_library gnat-array-split-g-arrspl-ads}@anchor{326}@anchor{gnat_rm/the_gnat_library id43}@anchor{327} @section @code{GNAT.Array_Split} (@code{g-arrspl.ads}) @@ -23807,7 +23834,7 @@ an array wherever the separators appear, and provide direct access to the resulting slices. @node GNAT AWK g-awk ads,GNAT Bind_Environment g-binenv ads,GNAT Array_Split g-arrspl ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id44}@anchor{324}@anchor{gnat_rm/the_gnat_library gnat-awk-g-awk-ads}@anchor{325} +@anchor{gnat_rm/the_gnat_library id44}@anchor{328}@anchor{gnat_rm/the_gnat_library gnat-awk-g-awk-ads}@anchor{329} @section @code{GNAT.AWK} (@code{g-awk.ads}) @@ -23822,7 +23849,7 @@ or more files containing formatted data. The file is viewed as a database where each record is a line and a field is a data element in this line. @node GNAT Bind_Environment g-binenv ads,GNAT Branch_Prediction g-brapre ads,GNAT AWK g-awk ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-bind-environment-g-binenv-ads}@anchor{326}@anchor{gnat_rm/the_gnat_library id45}@anchor{327} +@anchor{gnat_rm/the_gnat_library gnat-bind-environment-g-binenv-ads}@anchor{32a}@anchor{gnat_rm/the_gnat_library id45}@anchor{32b} @section @code{GNAT.Bind_Environment} (@code{g-binenv.ads}) @@ -23835,7 +23862,7 @@ These associations can be specified using the @code{-V} binder command line switch. @node GNAT Branch_Prediction g-brapre ads,GNAT Bounded_Buffers g-boubuf ads,GNAT Bind_Environment g-binenv ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id46}@anchor{328}@anchor{gnat_rm/the_gnat_library gnat-branch-prediction-g-brapre-ads}@anchor{329} +@anchor{gnat_rm/the_gnat_library id46}@anchor{32c}@anchor{gnat_rm/the_gnat_library gnat-branch-prediction-g-brapre-ads}@anchor{32d} @section @code{GNAT.Branch_Prediction} (@code{g-brapre.ads}) @@ -23846,7 +23873,7 @@ line switch. Provides routines giving hints to the branch predictor of the code generator. @node GNAT Bounded_Buffers g-boubuf ads,GNAT Bounded_Mailboxes g-boumai ads,GNAT Branch_Prediction g-brapre ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id47}@anchor{32a}@anchor{gnat_rm/the_gnat_library gnat-bounded-buffers-g-boubuf-ads}@anchor{32b} +@anchor{gnat_rm/the_gnat_library id47}@anchor{32e}@anchor{gnat_rm/the_gnat_library gnat-bounded-buffers-g-boubuf-ads}@anchor{32f} @section @code{GNAT.Bounded_Buffers} (@code{g-boubuf.ads}) @@ -23861,7 +23888,7 @@ useful directly or as parts of the implementations of other abstractions, such as mailboxes. @node GNAT Bounded_Mailboxes g-boumai ads,GNAT Bubble_Sort g-bubsor ads,GNAT Bounded_Buffers g-boubuf ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-bounded-mailboxes-g-boumai-ads}@anchor{32c}@anchor{gnat_rm/the_gnat_library id48}@anchor{32d} +@anchor{gnat_rm/the_gnat_library gnat-bounded-mailboxes-g-boumai-ads}@anchor{330}@anchor{gnat_rm/the_gnat_library id48}@anchor{331} @section @code{GNAT.Bounded_Mailboxes} (@code{g-boumai.ads}) @@ -23874,7 +23901,7 @@ such as mailboxes. Provides a thread-safe asynchronous intertask mailbox communication facility. @node GNAT Bubble_Sort g-bubsor ads,GNAT Bubble_Sort_A g-busora ads,GNAT Bounded_Mailboxes g-boumai ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-bubble-sort-g-bubsor-ads}@anchor{32e}@anchor{gnat_rm/the_gnat_library id49}@anchor{32f} +@anchor{gnat_rm/the_gnat_library gnat-bubble-sort-g-bubsor-ads}@anchor{332}@anchor{gnat_rm/the_gnat_library id49}@anchor{333} @section @code{GNAT.Bubble_Sort} (@code{g-bubsor.ads}) @@ -23889,7 +23916,7 @@ data items. Exchange and comparison procedures are provided by passing access-to-procedure values. @node GNAT Bubble_Sort_A g-busora ads,GNAT Bubble_Sort_G g-busorg ads,GNAT Bubble_Sort g-bubsor ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id50}@anchor{330}@anchor{gnat_rm/the_gnat_library gnat-bubble-sort-a-g-busora-ads}@anchor{331} +@anchor{gnat_rm/the_gnat_library id50}@anchor{334}@anchor{gnat_rm/the_gnat_library gnat-bubble-sort-a-g-busora-ads}@anchor{335} @section @code{GNAT.Bubble_Sort_A} (@code{g-busora.ads}) @@ -23905,7 +23932,7 @@ access-to-procedure values. This is an older version, retained for compatibility. Usually @code{GNAT.Bubble_Sort} will be preferable. @node GNAT Bubble_Sort_G g-busorg ads,GNAT Byte_Order_Mark g-byorma ads,GNAT Bubble_Sort_A g-busora ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-bubble-sort-g-g-busorg-ads}@anchor{332}@anchor{gnat_rm/the_gnat_library id51}@anchor{333} +@anchor{gnat_rm/the_gnat_library gnat-bubble-sort-g-g-busorg-ads}@anchor{336}@anchor{gnat_rm/the_gnat_library id51}@anchor{337} @section @code{GNAT.Bubble_Sort_G} (@code{g-busorg.ads}) @@ -23921,7 +23948,7 @@ if the procedures can be inlined, at the expense of duplicating code for multiple instantiations. @node GNAT Byte_Order_Mark g-byorma ads,GNAT Byte_Swapping g-bytswa ads,GNAT Bubble_Sort_G g-busorg ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-byte-order-mark-g-byorma-ads}@anchor{334}@anchor{gnat_rm/the_gnat_library id52}@anchor{335} +@anchor{gnat_rm/the_gnat_library gnat-byte-order-mark-g-byorma-ads}@anchor{338}@anchor{gnat_rm/the_gnat_library id52}@anchor{339} @section @code{GNAT.Byte_Order_Mark} (@code{g-byorma.ads}) @@ -23937,7 +23964,7 @@ the encoding of the string. The routine includes detection of special XML sequences for various UCS input formats. @node GNAT Byte_Swapping g-bytswa ads,GNAT Calendar g-calend ads,GNAT Byte_Order_Mark g-byorma ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-byte-swapping-g-bytswa-ads}@anchor{336}@anchor{gnat_rm/the_gnat_library id53}@anchor{337} +@anchor{gnat_rm/the_gnat_library gnat-byte-swapping-g-bytswa-ads}@anchor{33a}@anchor{gnat_rm/the_gnat_library id53}@anchor{33b} @section @code{GNAT.Byte_Swapping} (@code{g-bytswa.ads}) @@ -23951,7 +23978,7 @@ General routines for swapping the bytes in 2-, 4-, and 8-byte quantities. Machine-specific implementations are available in some cases. @node GNAT Calendar g-calend ads,GNAT Calendar Time_IO g-catiio ads,GNAT Byte_Swapping g-bytswa ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id54}@anchor{338}@anchor{gnat_rm/the_gnat_library gnat-calendar-g-calend-ads}@anchor{339} +@anchor{gnat_rm/the_gnat_library id54}@anchor{33c}@anchor{gnat_rm/the_gnat_library gnat-calendar-g-calend-ads}@anchor{33d} @section @code{GNAT.Calendar} (@code{g-calend.ads}) @@ -23965,7 +23992,7 @@ Also provides conversion of @code{Ada.Calendar.Time} values to and from the C @code{timeval} format. @node GNAT Calendar Time_IO g-catiio ads,GNAT CRC32 g-crc32 ads,GNAT Calendar g-calend ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id55}@anchor{33a}@anchor{gnat_rm/the_gnat_library gnat-calendar-time-io-g-catiio-ads}@anchor{33b} +@anchor{gnat_rm/the_gnat_library id55}@anchor{33e}@anchor{gnat_rm/the_gnat_library gnat-calendar-time-io-g-catiio-ads}@anchor{33f} @section @code{GNAT.Calendar.Time_IO} (@code{g-catiio.ads}) @@ -23976,7 +24003,7 @@ C @code{timeval} format. @geindex GNAT.Calendar.Time_IO (g-catiio.ads) @node GNAT CRC32 g-crc32 ads,GNAT Case_Util g-casuti ads,GNAT Calendar Time_IO g-catiio ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id56}@anchor{33c}@anchor{gnat_rm/the_gnat_library gnat-crc32-g-crc32-ads}@anchor{33d} +@anchor{gnat_rm/the_gnat_library id56}@anchor{340}@anchor{gnat_rm/the_gnat_library gnat-crc32-g-crc32-ads}@anchor{341} @section @code{GNAT.CRC32} (@code{g-crc32.ads}) @@ -23993,7 +24020,7 @@ of this algorithm see Aug. 1988. Sarwate, D.V. @node GNAT Case_Util g-casuti ads,GNAT CGI g-cgi ads,GNAT CRC32 g-crc32 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id57}@anchor{33e}@anchor{gnat_rm/the_gnat_library gnat-case-util-g-casuti-ads}@anchor{33f} +@anchor{gnat_rm/the_gnat_library id57}@anchor{342}@anchor{gnat_rm/the_gnat_library gnat-case-util-g-casuti-ads}@anchor{343} @section @code{GNAT.Case_Util} (@code{g-casuti.ads}) @@ -24008,7 +24035,7 @@ without the overhead of the full casing tables in @code{Ada.Characters.Handling}. @node GNAT CGI g-cgi ads,GNAT CGI Cookie g-cgicoo ads,GNAT Case_Util g-casuti ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id58}@anchor{340}@anchor{gnat_rm/the_gnat_library gnat-cgi-g-cgi-ads}@anchor{341} +@anchor{gnat_rm/the_gnat_library id58}@anchor{344}@anchor{gnat_rm/the_gnat_library gnat-cgi-g-cgi-ads}@anchor{345} @section @code{GNAT.CGI} (@code{g-cgi.ads}) @@ -24023,7 +24050,7 @@ builds a table whose index is the key and provides some services to deal with this table. @node GNAT CGI Cookie g-cgicoo ads,GNAT CGI Debug g-cgideb ads,GNAT CGI g-cgi ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-cgi-cookie-g-cgicoo-ads}@anchor{342}@anchor{gnat_rm/the_gnat_library id59}@anchor{343} +@anchor{gnat_rm/the_gnat_library gnat-cgi-cookie-g-cgicoo-ads}@anchor{346}@anchor{gnat_rm/the_gnat_library id59}@anchor{347} @section @code{GNAT.CGI.Cookie} (@code{g-cgicoo.ads}) @@ -24038,7 +24065,7 @@ Common Gateway Interface (CGI). It exports services to deal with Web cookies (piece of information kept in the Web client software). @node GNAT CGI Debug g-cgideb ads,GNAT Command_Line g-comlin ads,GNAT CGI Cookie g-cgicoo ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-cgi-debug-g-cgideb-ads}@anchor{344}@anchor{gnat_rm/the_gnat_library id60}@anchor{345} +@anchor{gnat_rm/the_gnat_library gnat-cgi-debug-g-cgideb-ads}@anchor{348}@anchor{gnat_rm/the_gnat_library id60}@anchor{349} @section @code{GNAT.CGI.Debug} (@code{g-cgideb.ads}) @@ -24050,7 +24077,7 @@ This is a package to help debugging CGI (Common Gateway Interface) programs written in Ada. @node GNAT Command_Line g-comlin ads,GNAT Compiler_Version g-comver ads,GNAT CGI Debug g-cgideb ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id61}@anchor{346}@anchor{gnat_rm/the_gnat_library gnat-command-line-g-comlin-ads}@anchor{347} +@anchor{gnat_rm/the_gnat_library id61}@anchor{34a}@anchor{gnat_rm/the_gnat_library gnat-command-line-g-comlin-ads}@anchor{34b} @section @code{GNAT.Command_Line} (@code{g-comlin.ads}) @@ -24063,7 +24090,7 @@ including the ability to scan for named switches with optional parameters and expand file names using wildcard notations. @node GNAT Compiler_Version g-comver ads,GNAT Ctrl_C g-ctrl_c ads,GNAT Command_Line g-comlin ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-compiler-version-g-comver-ads}@anchor{348}@anchor{gnat_rm/the_gnat_library id62}@anchor{349} +@anchor{gnat_rm/the_gnat_library gnat-compiler-version-g-comver-ads}@anchor{34c}@anchor{gnat_rm/the_gnat_library id62}@anchor{34d} @section @code{GNAT.Compiler_Version} (@code{g-comver.ads}) @@ -24081,7 +24108,7 @@ of the compiler if a consistent tool set is used to compile all units of a partition). @node GNAT Ctrl_C g-ctrl_c ads,GNAT Current_Exception g-curexc ads,GNAT Compiler_Version g-comver ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-ctrl-c-g-ctrl-c-ads}@anchor{34a}@anchor{gnat_rm/the_gnat_library id63}@anchor{34b} +@anchor{gnat_rm/the_gnat_library gnat-ctrl-c-g-ctrl-c-ads}@anchor{34e}@anchor{gnat_rm/the_gnat_library id63}@anchor{34f} @section @code{GNAT.Ctrl_C} (@code{g-ctrl_c.ads}) @@ -24092,7 +24119,7 @@ of a partition). Provides a simple interface to handle Ctrl-C keyboard events. @node GNAT Current_Exception g-curexc ads,GNAT Debug_Pools g-debpoo ads,GNAT Ctrl_C g-ctrl_c ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id64}@anchor{34c}@anchor{gnat_rm/the_gnat_library gnat-current-exception-g-curexc-ads}@anchor{34d} +@anchor{gnat_rm/the_gnat_library id64}@anchor{350}@anchor{gnat_rm/the_gnat_library gnat-current-exception-g-curexc-ads}@anchor{351} @section @code{GNAT.Current_Exception} (@code{g-curexc.ads}) @@ -24109,7 +24136,7 @@ This is particularly useful in simulating typical facilities for obtaining information about exceptions provided by Ada 83 compilers. @node GNAT Debug_Pools g-debpoo ads,GNAT Debug_Utilities g-debuti ads,GNAT Current_Exception g-curexc ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-debug-pools-g-debpoo-ads}@anchor{34e}@anchor{gnat_rm/the_gnat_library id65}@anchor{34f} +@anchor{gnat_rm/the_gnat_library gnat-debug-pools-g-debpoo-ads}@anchor{352}@anchor{gnat_rm/the_gnat_library id65}@anchor{353} @section @code{GNAT.Debug_Pools} (@code{g-debpoo.ads}) @@ -24126,7 +24153,7 @@ problems. See @code{The GNAT Debug_Pool Facility} section in the @cite{GNAT User's Guide}. @node GNAT Debug_Utilities g-debuti ads,GNAT Decode_String g-decstr ads,GNAT Debug_Pools g-debpoo ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-debug-utilities-g-debuti-ads}@anchor{350}@anchor{gnat_rm/the_gnat_library id66}@anchor{351} +@anchor{gnat_rm/the_gnat_library gnat-debug-utilities-g-debuti-ads}@anchor{354}@anchor{gnat_rm/the_gnat_library id66}@anchor{355} @section @code{GNAT.Debug_Utilities} (@code{g-debuti.ads}) @@ -24139,7 +24166,7 @@ to and from string images of address values. Supports both C and Ada formats for hexadecimal literals. @node GNAT Decode_String g-decstr ads,GNAT Decode_UTF8_String g-deutst ads,GNAT Debug_Utilities g-debuti ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id67}@anchor{352}@anchor{gnat_rm/the_gnat_library gnat-decode-string-g-decstr-ads}@anchor{353} +@anchor{gnat_rm/the_gnat_library id67}@anchor{356}@anchor{gnat_rm/the_gnat_library gnat-decode-string-g-decstr-ads}@anchor{357} @section @code{GNAT.Decode_String} (@code{g-decstr.ads}) @@ -24163,7 +24190,7 @@ Useful in conjunction with Unicode character coding. Note there is a preinstantiation for UTF-8. See next entry. @node GNAT Decode_UTF8_String g-deutst ads,GNAT Directory_Operations g-dirope ads,GNAT Decode_String g-decstr ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-decode-utf8-string-g-deutst-ads}@anchor{354}@anchor{gnat_rm/the_gnat_library id68}@anchor{355} +@anchor{gnat_rm/the_gnat_library gnat-decode-utf8-string-g-deutst-ads}@anchor{358}@anchor{gnat_rm/the_gnat_library id68}@anchor{359} @section @code{GNAT.Decode_UTF8_String} (@code{g-deutst.ads}) @@ -24184,7 +24211,7 @@ preinstantiation for UTF-8. See next entry. A preinstantiation of GNAT.Decode_Strings for UTF-8 encoding. @node GNAT Directory_Operations g-dirope ads,GNAT Directory_Operations Iteration g-diopit ads,GNAT Decode_UTF8_String g-deutst ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id69}@anchor{356}@anchor{gnat_rm/the_gnat_library gnat-directory-operations-g-dirope-ads}@anchor{357} +@anchor{gnat_rm/the_gnat_library id69}@anchor{35a}@anchor{gnat_rm/the_gnat_library gnat-directory-operations-g-dirope-ads}@anchor{35b} @section @code{GNAT.Directory_Operations} (@code{g-dirope.ads}) @@ -24197,7 +24224,7 @@ the current directory, making new directories, and scanning the files in a directory. @node GNAT Directory_Operations Iteration g-diopit ads,GNAT Dynamic_HTables g-dynhta ads,GNAT Directory_Operations g-dirope ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id70}@anchor{358}@anchor{gnat_rm/the_gnat_library gnat-directory-operations-iteration-g-diopit-ads}@anchor{359} +@anchor{gnat_rm/the_gnat_library id70}@anchor{35c}@anchor{gnat_rm/the_gnat_library gnat-directory-operations-iteration-g-diopit-ads}@anchor{35d} @section @code{GNAT.Directory_Operations.Iteration} (@code{g-diopit.ads}) @@ -24209,7 +24236,7 @@ A child unit of GNAT.Directory_Operations providing additional operations for iterating through directories. @node GNAT Dynamic_HTables g-dynhta ads,GNAT Dynamic_Tables g-dyntab ads,GNAT Directory_Operations Iteration g-diopit ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id71}@anchor{35a}@anchor{gnat_rm/the_gnat_library gnat-dynamic-htables-g-dynhta-ads}@anchor{35b} +@anchor{gnat_rm/the_gnat_library id71}@anchor{35e}@anchor{gnat_rm/the_gnat_library gnat-dynamic-htables-g-dynhta-ads}@anchor{35f} @section @code{GNAT.Dynamic_HTables} (@code{g-dynhta.ads}) @@ -24227,7 +24254,7 @@ dynamic instances of the hash table, while an instantiation of @code{GNAT.HTable} creates a single instance of the hash table. @node GNAT Dynamic_Tables g-dyntab ads,GNAT Encode_String g-encstr ads,GNAT Dynamic_HTables g-dynhta ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-dynamic-tables-g-dyntab-ads}@anchor{35c}@anchor{gnat_rm/the_gnat_library id72}@anchor{35d} +@anchor{gnat_rm/the_gnat_library gnat-dynamic-tables-g-dyntab-ads}@anchor{360}@anchor{gnat_rm/the_gnat_library id72}@anchor{361} @section @code{GNAT.Dynamic_Tables} (@code{g-dyntab.ads}) @@ -24247,7 +24274,7 @@ dynamic instances of the table, while an instantiation of @code{GNAT.Table} creates a single instance of the table type. @node GNAT Encode_String g-encstr ads,GNAT Encode_UTF8_String g-enutst ads,GNAT Dynamic_Tables g-dyntab ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id73}@anchor{35e}@anchor{gnat_rm/the_gnat_library gnat-encode-string-g-encstr-ads}@anchor{35f} +@anchor{gnat_rm/the_gnat_library id73}@anchor{362}@anchor{gnat_rm/the_gnat_library gnat-encode-string-g-encstr-ads}@anchor{363} @section @code{GNAT.Encode_String} (@code{g-encstr.ads}) @@ -24269,7 +24296,7 @@ encoding method. Useful in conjunction with Unicode character coding. Note there is a preinstantiation for UTF-8. See next entry. @node GNAT Encode_UTF8_String g-enutst ads,GNAT Exception_Actions g-excact ads,GNAT Encode_String g-encstr ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-encode-utf8-string-g-enutst-ads}@anchor{360}@anchor{gnat_rm/the_gnat_library id74}@anchor{361} +@anchor{gnat_rm/the_gnat_library gnat-encode-utf8-string-g-enutst-ads}@anchor{364}@anchor{gnat_rm/the_gnat_library id74}@anchor{365} @section @code{GNAT.Encode_UTF8_String} (@code{g-enutst.ads}) @@ -24290,7 +24317,7 @@ Note there is a preinstantiation for UTF-8. See next entry. A preinstantiation of GNAT.Encode_Strings for UTF-8 encoding. @node GNAT Exception_Actions g-excact ads,GNAT Exception_Traces g-exctra ads,GNAT Encode_UTF8_String g-enutst ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-exception-actions-g-excact-ads}@anchor{362}@anchor{gnat_rm/the_gnat_library id75}@anchor{363} +@anchor{gnat_rm/the_gnat_library gnat-exception-actions-g-excact-ads}@anchor{366}@anchor{gnat_rm/the_gnat_library id75}@anchor{367} @section @code{GNAT.Exception_Actions} (@code{g-excact.ads}) @@ -24303,7 +24330,7 @@ for specific exceptions, or when any exception is raised. This can be used for instance to force a core dump to ease debugging. @node GNAT Exception_Traces g-exctra ads,GNAT Exceptions g-except ads,GNAT Exception_Actions g-excact ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-exception-traces-g-exctra-ads}@anchor{364}@anchor{gnat_rm/the_gnat_library id76}@anchor{365} +@anchor{gnat_rm/the_gnat_library gnat-exception-traces-g-exctra-ads}@anchor{368}@anchor{gnat_rm/the_gnat_library id76}@anchor{369} @section @code{GNAT.Exception_Traces} (@code{g-exctra.ads}) @@ -24317,7 +24344,7 @@ Provides an interface allowing to control automatic output upon exception occurrences. @node GNAT Exceptions g-except ads,GNAT Expect g-expect ads,GNAT Exception_Traces g-exctra ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id77}@anchor{366}@anchor{gnat_rm/the_gnat_library gnat-exceptions-g-except-ads}@anchor{367} +@anchor{gnat_rm/the_gnat_library id77}@anchor{36a}@anchor{gnat_rm/the_gnat_library gnat-exceptions-g-except-ads}@anchor{36b} @section @code{GNAT.Exceptions} (@code{g-except.ads}) @@ -24338,7 +24365,7 @@ predefined exceptions, and for example allow raising @code{Constraint_Error} with a message from a pure subprogram. @node GNAT Expect g-expect ads,GNAT Expect TTY g-exptty ads,GNAT Exceptions g-except ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id78}@anchor{368}@anchor{gnat_rm/the_gnat_library gnat-expect-g-expect-ads}@anchor{369} +@anchor{gnat_rm/the_gnat_library id78}@anchor{36c}@anchor{gnat_rm/the_gnat_library gnat-expect-g-expect-ads}@anchor{36d} @section @code{GNAT.Expect} (@code{g-expect.ads}) @@ -24354,7 +24381,7 @@ It is not implemented for cross ports, and in particular is not implemented for VxWorks or LynxOS. @node GNAT Expect TTY g-exptty ads,GNAT Float_Control g-flocon ads,GNAT Expect g-expect ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id79}@anchor{36a}@anchor{gnat_rm/the_gnat_library gnat-expect-tty-g-exptty-ads}@anchor{36b} +@anchor{gnat_rm/the_gnat_library id79}@anchor{36e}@anchor{gnat_rm/the_gnat_library gnat-expect-tty-g-exptty-ads}@anchor{36f} @section @code{GNAT.Expect.TTY} (@code{g-exptty.ads}) @@ -24366,7 +24393,7 @@ ports. It is not implemented for cross ports, and in particular is not implemented for VxWorks or LynxOS. @node GNAT Float_Control g-flocon ads,GNAT Formatted_String g-forstr ads,GNAT Expect TTY g-exptty ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id80}@anchor{36c}@anchor{gnat_rm/the_gnat_library gnat-float-control-g-flocon-ads}@anchor{36d} +@anchor{gnat_rm/the_gnat_library id80}@anchor{370}@anchor{gnat_rm/the_gnat_library gnat-float-control-g-flocon-ads}@anchor{371} @section @code{GNAT.Float_Control} (@code{g-flocon.ads}) @@ -24380,7 +24407,7 @@ library calls may cause this mode to be modified, and the Reset procedure in this package can be used to reestablish the required mode. @node GNAT Formatted_String g-forstr ads,GNAT Heap_Sort g-heasor ads,GNAT Float_Control g-flocon ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id81}@anchor{36e}@anchor{gnat_rm/the_gnat_library gnat-formatted-string-g-forstr-ads}@anchor{36f} +@anchor{gnat_rm/the_gnat_library id81}@anchor{372}@anchor{gnat_rm/the_gnat_library gnat-formatted-string-g-forstr-ads}@anchor{373} @section @code{GNAT.Formatted_String} (@code{g-forstr.ads}) @@ -24395,7 +24422,7 @@ derived from Integer, Float or enumerations as values for the formatted string. @node GNAT Heap_Sort g-heasor ads,GNAT Heap_Sort_A g-hesora ads,GNAT Formatted_String g-forstr ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-heap-sort-g-heasor-ads}@anchor{370}@anchor{gnat_rm/the_gnat_library id82}@anchor{371} +@anchor{gnat_rm/the_gnat_library gnat-heap-sort-g-heasor-ads}@anchor{374}@anchor{gnat_rm/the_gnat_library id82}@anchor{375} @section @code{GNAT.Heap_Sort} (@code{g-heasor.ads}) @@ -24409,7 +24436,7 @@ access-to-procedure values. The algorithm used is a modified heap sort that performs approximately N*log(N) comparisons in the worst case. @node GNAT Heap_Sort_A g-hesora ads,GNAT Heap_Sort_G g-hesorg ads,GNAT Heap_Sort g-heasor ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id83}@anchor{372}@anchor{gnat_rm/the_gnat_library gnat-heap-sort-a-g-hesora-ads}@anchor{373} +@anchor{gnat_rm/the_gnat_library id83}@anchor{376}@anchor{gnat_rm/the_gnat_library gnat-heap-sort-a-g-hesora-ads}@anchor{377} @section @code{GNAT.Heap_Sort_A} (@code{g-hesora.ads}) @@ -24425,7 +24452,7 @@ This differs from @code{GNAT.Heap_Sort} in having a less convenient interface, but may be slightly more efficient. @node GNAT Heap_Sort_G g-hesorg ads,GNAT HTable g-htable ads,GNAT Heap_Sort_A g-hesora ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id84}@anchor{374}@anchor{gnat_rm/the_gnat_library gnat-heap-sort-g-g-hesorg-ads}@anchor{375} +@anchor{gnat_rm/the_gnat_library id84}@anchor{378}@anchor{gnat_rm/the_gnat_library gnat-heap-sort-g-g-hesorg-ads}@anchor{379} @section @code{GNAT.Heap_Sort_G} (@code{g-hesorg.ads}) @@ -24439,7 +24466,7 @@ if the procedures can be inlined, at the expense of duplicating code for multiple instantiations. @node GNAT HTable g-htable ads,GNAT IO g-io ads,GNAT Heap_Sort_G g-hesorg ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id85}@anchor{376}@anchor{gnat_rm/the_gnat_library gnat-htable-g-htable-ads}@anchor{377} +@anchor{gnat_rm/the_gnat_library id85}@anchor{37a}@anchor{gnat_rm/the_gnat_library gnat-htable-g-htable-ads}@anchor{37b} @section @code{GNAT.HTable} (@code{g-htable.ads}) @@ -24452,7 +24479,7 @@ data. Provides two approaches, one a simple static approach, and the other allowing arbitrary dynamic hash tables. @node GNAT IO g-io ads,GNAT IO_Aux g-io_aux ads,GNAT HTable g-htable ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id86}@anchor{378}@anchor{gnat_rm/the_gnat_library gnat-io-g-io-ads}@anchor{379} +@anchor{gnat_rm/the_gnat_library id86}@anchor{37c}@anchor{gnat_rm/the_gnat_library gnat-io-g-io-ads}@anchor{37d} @section @code{GNAT.IO} (@code{g-io.ads}) @@ -24468,7 +24495,7 @@ Standard_Input, and writing characters, strings and integers to either Standard_Output or Standard_Error. @node GNAT IO_Aux g-io_aux ads,GNAT Lock_Files g-locfil ads,GNAT IO g-io ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id87}@anchor{37a}@anchor{gnat_rm/the_gnat_library gnat-io-aux-g-io-aux-ads}@anchor{37b} +@anchor{gnat_rm/the_gnat_library id87}@anchor{37e}@anchor{gnat_rm/the_gnat_library gnat-io-aux-g-io-aux-ads}@anchor{37f} @section @code{GNAT.IO_Aux} (@code{g-io_aux.ads}) @@ -24482,7 +24509,7 @@ Provides some auxiliary functions for use with Text_IO, including a test for whether a file exists, and functions for reading a line of text. @node GNAT Lock_Files g-locfil ads,GNAT MBBS_Discrete_Random g-mbdira ads,GNAT IO_Aux g-io_aux ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id88}@anchor{37c}@anchor{gnat_rm/the_gnat_library gnat-lock-files-g-locfil-ads}@anchor{37d} +@anchor{gnat_rm/the_gnat_library id88}@anchor{380}@anchor{gnat_rm/the_gnat_library gnat-lock-files-g-locfil-ads}@anchor{381} @section @code{GNAT.Lock_Files} (@code{g-locfil.ads}) @@ -24496,7 +24523,7 @@ Provides a general interface for using files as locks. Can be used for providing program level synchronization. @node GNAT MBBS_Discrete_Random g-mbdira ads,GNAT MBBS_Float_Random g-mbflra ads,GNAT Lock_Files g-locfil ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id89}@anchor{37e}@anchor{gnat_rm/the_gnat_library gnat-mbbs-discrete-random-g-mbdira-ads}@anchor{37f} +@anchor{gnat_rm/the_gnat_library id89}@anchor{382}@anchor{gnat_rm/the_gnat_library gnat-mbbs-discrete-random-g-mbdira-ads}@anchor{383} @section @code{GNAT.MBBS_Discrete_Random} (@code{g-mbdira.ads}) @@ -24508,7 +24535,7 @@ The original implementation of @code{Ada.Numerics.Discrete_Random}. Uses a modified version of the Blum-Blum-Shub generator. @node GNAT MBBS_Float_Random g-mbflra ads,GNAT MD5 g-md5 ads,GNAT MBBS_Discrete_Random g-mbdira ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id90}@anchor{380}@anchor{gnat_rm/the_gnat_library gnat-mbbs-float-random-g-mbflra-ads}@anchor{381} +@anchor{gnat_rm/the_gnat_library id90}@anchor{384}@anchor{gnat_rm/the_gnat_library gnat-mbbs-float-random-g-mbflra-ads}@anchor{385} @section @code{GNAT.MBBS_Float_Random} (@code{g-mbflra.ads}) @@ -24520,7 +24547,7 @@ The original implementation of @code{Ada.Numerics.Float_Random}. Uses a modified version of the Blum-Blum-Shub generator. @node GNAT MD5 g-md5 ads,GNAT Memory_Dump g-memdum ads,GNAT MBBS_Float_Random g-mbflra ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id91}@anchor{382}@anchor{gnat_rm/the_gnat_library gnat-md5-g-md5-ads}@anchor{383} +@anchor{gnat_rm/the_gnat_library id91}@anchor{386}@anchor{gnat_rm/the_gnat_library gnat-md5-g-md5-ads}@anchor{387} @section @code{GNAT.MD5} (@code{g-md5.ads}) @@ -24533,7 +24560,7 @@ the HMAC-MD5 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT Memory_Dump g-memdum ads,GNAT Most_Recent_Exception g-moreex ads,GNAT MD5 g-md5 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id92}@anchor{384}@anchor{gnat_rm/the_gnat_library gnat-memory-dump-g-memdum-ads}@anchor{385} +@anchor{gnat_rm/the_gnat_library id92}@anchor{388}@anchor{gnat_rm/the_gnat_library gnat-memory-dump-g-memdum-ads}@anchor{389} @section @code{GNAT.Memory_Dump} (@code{g-memdum.ads}) @@ -24546,7 +24573,7 @@ standard output or standard error files. Uses GNAT.IO for actual output. @node GNAT Most_Recent_Exception g-moreex ads,GNAT OS_Lib g-os_lib ads,GNAT Memory_Dump g-memdum ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-most-recent-exception-g-moreex-ads}@anchor{386}@anchor{gnat_rm/the_gnat_library id93}@anchor{387} +@anchor{gnat_rm/the_gnat_library gnat-most-recent-exception-g-moreex-ads}@anchor{38a}@anchor{gnat_rm/the_gnat_library id93}@anchor{38b} @section @code{GNAT.Most_Recent_Exception} (@code{g-moreex.ads}) @@ -24560,7 +24587,7 @@ various logging purposes, including duplicating functionality of some Ada 83 implementation dependent extensions. @node GNAT OS_Lib g-os_lib ads,GNAT Perfect_Hash_Generators g-pehage ads,GNAT Most_Recent_Exception g-moreex ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-os-lib-g-os-lib-ads}@anchor{388}@anchor{gnat_rm/the_gnat_library id94}@anchor{389} +@anchor{gnat_rm/the_gnat_library gnat-os-lib-g-os-lib-ads}@anchor{38c}@anchor{gnat_rm/the_gnat_library id94}@anchor{38d} @section @code{GNAT.OS_Lib} (@code{g-os_lib.ads}) @@ -24576,7 +24603,7 @@ including a portable spawn procedure, and access to environment variables and error return codes. @node GNAT Perfect_Hash_Generators g-pehage ads,GNAT Random_Numbers g-rannum ads,GNAT OS_Lib g-os_lib ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-perfect-hash-generators-g-pehage-ads}@anchor{38a}@anchor{gnat_rm/the_gnat_library id95}@anchor{38b} +@anchor{gnat_rm/the_gnat_library gnat-perfect-hash-generators-g-pehage-ads}@anchor{38e}@anchor{gnat_rm/the_gnat_library id95}@anchor{38f} @section @code{GNAT.Perfect_Hash_Generators} (@code{g-pehage.ads}) @@ -24594,7 +24621,7 @@ hashcode are in the same order. These hashing functions are very convenient for use with realtime applications. @node GNAT Random_Numbers g-rannum ads,GNAT Regexp g-regexp ads,GNAT Perfect_Hash_Generators g-pehage ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-random-numbers-g-rannum-ads}@anchor{38c}@anchor{gnat_rm/the_gnat_library id96}@anchor{38d} +@anchor{gnat_rm/the_gnat_library gnat-random-numbers-g-rannum-ads}@anchor{390}@anchor{gnat_rm/the_gnat_library id96}@anchor{391} @section @code{GNAT.Random_Numbers} (@code{g-rannum.ads}) @@ -24606,7 +24633,7 @@ Provides random number capabilities which extend those available in the standard Ada library and are more convenient to use. @node GNAT Regexp g-regexp ads,GNAT Registry g-regist ads,GNAT Random_Numbers g-rannum ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-regexp-g-regexp-ads}@anchor{255}@anchor{gnat_rm/the_gnat_library id97}@anchor{38e} +@anchor{gnat_rm/the_gnat_library gnat-regexp-g-regexp-ads}@anchor{259}@anchor{gnat_rm/the_gnat_library id97}@anchor{392} @section @code{GNAT.Regexp} (@code{g-regexp.ads}) @@ -24622,7 +24649,7 @@ simplest of the three pattern matching packages provided, and is particularly suitable for 'file globbing' applications. @node GNAT Registry g-regist ads,GNAT Regpat g-regpat ads,GNAT Regexp g-regexp ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id98}@anchor{38f}@anchor{gnat_rm/the_gnat_library gnat-registry-g-regist-ads}@anchor{390} +@anchor{gnat_rm/the_gnat_library id98}@anchor{393}@anchor{gnat_rm/the_gnat_library gnat-registry-g-regist-ads}@anchor{394} @section @code{GNAT.Registry} (@code{g-regist.ads}) @@ -24636,7 +24663,7 @@ registry API, but at a lower level of abstraction, refer to the Win32.Winreg package provided with the Win32Ada binding @node GNAT Regpat g-regpat ads,GNAT Rewrite_Data g-rewdat ads,GNAT Registry g-regist ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id99}@anchor{391}@anchor{gnat_rm/the_gnat_library gnat-regpat-g-regpat-ads}@anchor{392} +@anchor{gnat_rm/the_gnat_library id99}@anchor{395}@anchor{gnat_rm/the_gnat_library gnat-regpat-g-regpat-ads}@anchor{396} @section @code{GNAT.Regpat} (@code{g-regpat.ads}) @@ -24651,7 +24678,7 @@ from the original V7 style regular expression library written in C by Henry Spencer (and binary compatible with this C library). @node GNAT Rewrite_Data g-rewdat ads,GNAT Secondary_Stack_Info g-sestin ads,GNAT Regpat g-regpat ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id100}@anchor{393}@anchor{gnat_rm/the_gnat_library gnat-rewrite-data-g-rewdat-ads}@anchor{394} +@anchor{gnat_rm/the_gnat_library id100}@anchor{397}@anchor{gnat_rm/the_gnat_library gnat-rewrite-data-g-rewdat-ads}@anchor{398} @section @code{GNAT.Rewrite_Data} (@code{g-rewdat.ads}) @@ -24665,7 +24692,7 @@ full content to be processed is not loaded into memory all at once. This makes this interface usable for large files or socket streams. @node GNAT Secondary_Stack_Info g-sestin ads,GNAT Semaphores g-semaph ads,GNAT Rewrite_Data g-rewdat ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id101}@anchor{395}@anchor{gnat_rm/the_gnat_library gnat-secondary-stack-info-g-sestin-ads}@anchor{396} +@anchor{gnat_rm/the_gnat_library id101}@anchor{399}@anchor{gnat_rm/the_gnat_library gnat-secondary-stack-info-g-sestin-ads}@anchor{39a} @section @code{GNAT.Secondary_Stack_Info} (@code{g-sestin.ads}) @@ -24677,7 +24704,7 @@ Provide the capability to query the high water mark of the current task's secondary stack. @node GNAT Semaphores g-semaph ads,GNAT Serial_Communications g-sercom ads,GNAT Secondary_Stack_Info g-sestin ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id102}@anchor{397}@anchor{gnat_rm/the_gnat_library gnat-semaphores-g-semaph-ads}@anchor{398} +@anchor{gnat_rm/the_gnat_library id102}@anchor{39b}@anchor{gnat_rm/the_gnat_library gnat-semaphores-g-semaph-ads}@anchor{39c} @section @code{GNAT.Semaphores} (@code{g-semaph.ads}) @@ -24688,7 +24715,7 @@ secondary stack. Provides classic counting and binary semaphores using protected types. @node GNAT Serial_Communications g-sercom ads,GNAT SHA1 g-sha1 ads,GNAT Semaphores g-semaph ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-serial-communications-g-sercom-ads}@anchor{399}@anchor{gnat_rm/the_gnat_library id103}@anchor{39a} +@anchor{gnat_rm/the_gnat_library gnat-serial-communications-g-sercom-ads}@anchor{39d}@anchor{gnat_rm/the_gnat_library id103}@anchor{39e} @section @code{GNAT.Serial_Communications} (@code{g-sercom.ads}) @@ -24700,7 +24727,7 @@ Provides a simple interface to send and receive data over a serial port. This is only supported on GNU/Linux and Windows. @node GNAT SHA1 g-sha1 ads,GNAT SHA224 g-sha224 ads,GNAT Serial_Communications g-sercom ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sha1-g-sha1-ads}@anchor{39b}@anchor{gnat_rm/the_gnat_library id104}@anchor{39c} +@anchor{gnat_rm/the_gnat_library gnat-sha1-g-sha1-ads}@anchor{39f}@anchor{gnat_rm/the_gnat_library id104}@anchor{3a0} @section @code{GNAT.SHA1} (@code{g-sha1.ads}) @@ -24713,7 +24740,7 @@ and RFC 3174, and the HMAC-SHA1 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT SHA224 g-sha224 ads,GNAT SHA256 g-sha256 ads,GNAT SHA1 g-sha1 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sha224-g-sha224-ads}@anchor{39d}@anchor{gnat_rm/the_gnat_library id105}@anchor{39e} +@anchor{gnat_rm/the_gnat_library gnat-sha224-g-sha224-ads}@anchor{3a1}@anchor{gnat_rm/the_gnat_library id105}@anchor{3a2} @section @code{GNAT.SHA224} (@code{g-sha224.ads}) @@ -24726,7 +24753,7 @@ and the HMAC-SHA224 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT SHA256 g-sha256 ads,GNAT SHA384 g-sha384 ads,GNAT SHA224 g-sha224 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sha256-g-sha256-ads}@anchor{39f}@anchor{gnat_rm/the_gnat_library id106}@anchor{3a0} +@anchor{gnat_rm/the_gnat_library gnat-sha256-g-sha256-ads}@anchor{3a3}@anchor{gnat_rm/the_gnat_library id106}@anchor{3a4} @section @code{GNAT.SHA256} (@code{g-sha256.ads}) @@ -24739,7 +24766,7 @@ and the HMAC-SHA256 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT SHA384 g-sha384 ads,GNAT SHA512 g-sha512 ads,GNAT SHA256 g-sha256 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sha384-g-sha384-ads}@anchor{3a1}@anchor{gnat_rm/the_gnat_library id107}@anchor{3a2} +@anchor{gnat_rm/the_gnat_library gnat-sha384-g-sha384-ads}@anchor{3a5}@anchor{gnat_rm/the_gnat_library id107}@anchor{3a6} @section @code{GNAT.SHA384} (@code{g-sha384.ads}) @@ -24752,7 +24779,7 @@ and the HMAC-SHA384 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT SHA512 g-sha512 ads,GNAT Signals g-signal ads,GNAT SHA384 g-sha384 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id108}@anchor{3a3}@anchor{gnat_rm/the_gnat_library gnat-sha512-g-sha512-ads}@anchor{3a4} +@anchor{gnat_rm/the_gnat_library id108}@anchor{3a7}@anchor{gnat_rm/the_gnat_library gnat-sha512-g-sha512-ads}@anchor{3a8} @section @code{GNAT.SHA512} (@code{g-sha512.ads}) @@ -24765,7 +24792,7 @@ and the HMAC-SHA512 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT Signals g-signal ads,GNAT Sockets g-socket ads,GNAT SHA512 g-sha512 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id109}@anchor{3a5}@anchor{gnat_rm/the_gnat_library gnat-signals-g-signal-ads}@anchor{3a6} +@anchor{gnat_rm/the_gnat_library id109}@anchor{3a9}@anchor{gnat_rm/the_gnat_library gnat-signals-g-signal-ads}@anchor{3aa} @section @code{GNAT.Signals} (@code{g-signal.ads}) @@ -24777,7 +24804,7 @@ Provides the ability to manipulate the blocked status of signals on supported targets. @node GNAT Sockets g-socket ads,GNAT Source_Info g-souinf ads,GNAT Signals g-signal ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sockets-g-socket-ads}@anchor{3a7}@anchor{gnat_rm/the_gnat_library id110}@anchor{3a8} +@anchor{gnat_rm/the_gnat_library gnat-sockets-g-socket-ads}@anchor{3ab}@anchor{gnat_rm/the_gnat_library id110}@anchor{3ac} @section @code{GNAT.Sockets} (@code{g-socket.ads}) @@ -24792,7 +24819,7 @@ on all native GNAT ports and on VxWorks cross prots. It is not implemented for the LynxOS cross port. @node GNAT Source_Info g-souinf ads,GNAT Spelling_Checker g-speche ads,GNAT Sockets g-socket ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-source-info-g-souinf-ads}@anchor{3a9}@anchor{gnat_rm/the_gnat_library id111}@anchor{3aa} +@anchor{gnat_rm/the_gnat_library gnat-source-info-g-souinf-ads}@anchor{3ad}@anchor{gnat_rm/the_gnat_library id111}@anchor{3ae} @section @code{GNAT.Source_Info} (@code{g-souinf.ads}) @@ -24806,7 +24833,7 @@ subprograms yielding the date and time of the current compilation (like the C macros @code{__DATE__} and @code{__TIME__}) @node GNAT Spelling_Checker g-speche ads,GNAT Spelling_Checker_Generic g-spchge ads,GNAT Source_Info g-souinf ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id112}@anchor{3ab}@anchor{gnat_rm/the_gnat_library gnat-spelling-checker-g-speche-ads}@anchor{3ac} +@anchor{gnat_rm/the_gnat_library id112}@anchor{3af}@anchor{gnat_rm/the_gnat_library gnat-spelling-checker-g-speche-ads}@anchor{3b0} @section @code{GNAT.Spelling_Checker} (@code{g-speche.ads}) @@ -24818,7 +24845,7 @@ Provides a function for determining whether one string is a plausible near misspelling of another string. @node GNAT Spelling_Checker_Generic g-spchge ads,GNAT Spitbol Patterns g-spipat ads,GNAT Spelling_Checker g-speche ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spelling-checker-generic-g-spchge-ads}@anchor{3ad}@anchor{gnat_rm/the_gnat_library id113}@anchor{3ae} +@anchor{gnat_rm/the_gnat_library gnat-spelling-checker-generic-g-spchge-ads}@anchor{3b1}@anchor{gnat_rm/the_gnat_library id113}@anchor{3b2} @section @code{GNAT.Spelling_Checker_Generic} (@code{g-spchge.ads}) @@ -24831,7 +24858,7 @@ determining whether one string is a plausible near misspelling of another string. @node GNAT Spitbol Patterns g-spipat ads,GNAT Spitbol g-spitbo ads,GNAT Spelling_Checker_Generic g-spchge ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spitbol-patterns-g-spipat-ads}@anchor{3af}@anchor{gnat_rm/the_gnat_library id114}@anchor{3b0} +@anchor{gnat_rm/the_gnat_library gnat-spitbol-patterns-g-spipat-ads}@anchor{3b3}@anchor{gnat_rm/the_gnat_library id114}@anchor{3b4} @section @code{GNAT.Spitbol.Patterns} (@code{g-spipat.ads}) @@ -24847,7 +24874,7 @@ the SNOBOL4 dynamic pattern construction and matching capabilities, using the efficient algorithm developed by Robert Dewar for the SPITBOL system. @node GNAT Spitbol g-spitbo ads,GNAT Spitbol Table_Boolean g-sptabo ads,GNAT Spitbol Patterns g-spipat ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spitbol-g-spitbo-ads}@anchor{3b1}@anchor{gnat_rm/the_gnat_library id115}@anchor{3b2} +@anchor{gnat_rm/the_gnat_library gnat-spitbol-g-spitbo-ads}@anchor{3b5}@anchor{gnat_rm/the_gnat_library id115}@anchor{3b6} @section @code{GNAT.Spitbol} (@code{g-spitbo.ads}) @@ -24862,7 +24889,7 @@ useful for constructing arbitrary mappings from strings in the style of the SNOBOL4 TABLE function. @node GNAT Spitbol Table_Boolean g-sptabo ads,GNAT Spitbol Table_Integer g-sptain ads,GNAT Spitbol g-spitbo ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id116}@anchor{3b3}@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-boolean-g-sptabo-ads}@anchor{3b4} +@anchor{gnat_rm/the_gnat_library id116}@anchor{3b7}@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-boolean-g-sptabo-ads}@anchor{3b8} @section @code{GNAT.Spitbol.Table_Boolean} (@code{g-sptabo.ads}) @@ -24877,7 +24904,7 @@ for type @code{Standard.Boolean}, giving an implementation of sets of string values. @node GNAT Spitbol Table_Integer g-sptain ads,GNAT Spitbol Table_VString g-sptavs ads,GNAT Spitbol Table_Boolean g-sptabo ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-integer-g-sptain-ads}@anchor{3b5}@anchor{gnat_rm/the_gnat_library id117}@anchor{3b6} +@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-integer-g-sptain-ads}@anchor{3b9}@anchor{gnat_rm/the_gnat_library id117}@anchor{3ba} @section @code{GNAT.Spitbol.Table_Integer} (@code{g-sptain.ads}) @@ -24894,7 +24921,7 @@ for type @code{Standard.Integer}, giving an implementation of maps from string to integer values. @node GNAT Spitbol Table_VString g-sptavs ads,GNAT SSE g-sse ads,GNAT Spitbol Table_Integer g-sptain ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id118}@anchor{3b7}@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-vstring-g-sptavs-ads}@anchor{3b8} +@anchor{gnat_rm/the_gnat_library id118}@anchor{3bb}@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-vstring-g-sptavs-ads}@anchor{3bc} @section @code{GNAT.Spitbol.Table_VString} (@code{g-sptavs.ads}) @@ -24911,7 +24938,7 @@ a variable length string type, giving an implementation of general maps from strings to strings. @node GNAT SSE g-sse ads,GNAT SSE Vector_Types g-ssvety ads,GNAT Spitbol Table_VString g-sptavs ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id119}@anchor{3b9}@anchor{gnat_rm/the_gnat_library gnat-sse-g-sse-ads}@anchor{3ba} +@anchor{gnat_rm/the_gnat_library id119}@anchor{3bd}@anchor{gnat_rm/the_gnat_library gnat-sse-g-sse-ads}@anchor{3be} @section @code{GNAT.SSE} (@code{g-sse.ads}) @@ -24923,7 +24950,7 @@ targets. It exposes vector component types together with a general introduction to the binding contents and use. @node GNAT SSE Vector_Types g-ssvety ads,GNAT String_Hash g-strhas ads,GNAT SSE g-sse ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sse-vector-types-g-ssvety-ads}@anchor{3bb}@anchor{gnat_rm/the_gnat_library id120}@anchor{3bc} +@anchor{gnat_rm/the_gnat_library gnat-sse-vector-types-g-ssvety-ads}@anchor{3bf}@anchor{gnat_rm/the_gnat_library id120}@anchor{3c0} @section @code{GNAT.SSE.Vector_Types} (@code{g-ssvety.ads}) @@ -24932,7 +24959,7 @@ introduction to the binding contents and use. SSE vector types for use with SSE related intrinsics. @node GNAT String_Hash g-strhas ads,GNAT Strings g-string ads,GNAT SSE Vector_Types g-ssvety ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-string-hash-g-strhas-ads}@anchor{3bd}@anchor{gnat_rm/the_gnat_library id121}@anchor{3be} +@anchor{gnat_rm/the_gnat_library gnat-string-hash-g-strhas-ads}@anchor{3c1}@anchor{gnat_rm/the_gnat_library id121}@anchor{3c2} @section @code{GNAT.String_Hash} (@code{g-strhas.ads}) @@ -24944,7 +24971,7 @@ Provides a generic hash function working on arrays of scalars. Both the scalar type and the hash result type are parameters. @node GNAT Strings g-string ads,GNAT String_Split g-strspl ads,GNAT String_Hash g-strhas ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-strings-g-string-ads}@anchor{3bf}@anchor{gnat_rm/the_gnat_library id122}@anchor{3c0} +@anchor{gnat_rm/the_gnat_library gnat-strings-g-string-ads}@anchor{3c3}@anchor{gnat_rm/the_gnat_library id122}@anchor{3c4} @section @code{GNAT.Strings} (@code{g-string.ads}) @@ -24954,7 +24981,7 @@ Common String access types and related subprograms. Basically it defines a string access and an array of string access types. @node GNAT String_Split g-strspl ads,GNAT Table g-table ads,GNAT Strings g-string ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-string-split-g-strspl-ads}@anchor{3c1}@anchor{gnat_rm/the_gnat_library id123}@anchor{3c2} +@anchor{gnat_rm/the_gnat_library gnat-string-split-g-strspl-ads}@anchor{3c5}@anchor{gnat_rm/the_gnat_library id123}@anchor{3c6} @section @code{GNAT.String_Split} (@code{g-strspl.ads}) @@ -24968,7 +24995,7 @@ to the resulting slices. This package is instantiated from @code{GNAT.Array_Split}. @node GNAT Table g-table ads,GNAT Task_Lock g-tasloc ads,GNAT String_Split g-strspl ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id124}@anchor{3c3}@anchor{gnat_rm/the_gnat_library gnat-table-g-table-ads}@anchor{3c4} +@anchor{gnat_rm/the_gnat_library id124}@anchor{3c7}@anchor{gnat_rm/the_gnat_library gnat-table-g-table-ads}@anchor{3c8} @section @code{GNAT.Table} (@code{g-table.ads}) @@ -24988,7 +25015,7 @@ while an instantiation of @code{GNAT.Dynamic_Tables} creates a type that can be used to define dynamic instances of the table. @node GNAT Task_Lock g-tasloc ads,GNAT Time_Stamp g-timsta ads,GNAT Table g-table ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id125}@anchor{3c5}@anchor{gnat_rm/the_gnat_library gnat-task-lock-g-tasloc-ads}@anchor{3c6} +@anchor{gnat_rm/the_gnat_library id125}@anchor{3c9}@anchor{gnat_rm/the_gnat_library gnat-task-lock-g-tasloc-ads}@anchor{3ca} @section @code{GNAT.Task_Lock} (@code{g-tasloc.ads}) @@ -25005,7 +25032,7 @@ single global task lock. Appropriate for use in situations where contention between tasks is very rarely expected. @node GNAT Time_Stamp g-timsta ads,GNAT Threads g-thread ads,GNAT Task_Lock g-tasloc ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id126}@anchor{3c7}@anchor{gnat_rm/the_gnat_library gnat-time-stamp-g-timsta-ads}@anchor{3c8} +@anchor{gnat_rm/the_gnat_library id126}@anchor{3cb}@anchor{gnat_rm/the_gnat_library gnat-time-stamp-g-timsta-ads}@anchor{3cc} @section @code{GNAT.Time_Stamp} (@code{g-timsta.ads}) @@ -25020,7 +25047,7 @@ represents the current date and time in ISO 8601 format. This is a very simple routine with minimal code and there are no dependencies on any other unit. @node GNAT Threads g-thread ads,GNAT Traceback g-traceb ads,GNAT Time_Stamp g-timsta ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id127}@anchor{3c9}@anchor{gnat_rm/the_gnat_library gnat-threads-g-thread-ads}@anchor{3ca} +@anchor{gnat_rm/the_gnat_library id127}@anchor{3cd}@anchor{gnat_rm/the_gnat_library gnat-threads-g-thread-ads}@anchor{3ce} @section @code{GNAT.Threads} (@code{g-thread.ads}) @@ -25037,7 +25064,7 @@ further details if your program has threads that are created by a non-Ada environment which then accesses Ada code. @node GNAT Traceback g-traceb ads,GNAT Traceback Symbolic g-trasym ads,GNAT Threads g-thread ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id128}@anchor{3cb}@anchor{gnat_rm/the_gnat_library gnat-traceback-g-traceb-ads}@anchor{3cc} +@anchor{gnat_rm/the_gnat_library id128}@anchor{3cf}@anchor{gnat_rm/the_gnat_library gnat-traceback-g-traceb-ads}@anchor{3d0} @section @code{GNAT.Traceback} (@code{g-traceb.ads}) @@ -25049,7 +25076,7 @@ Provides a facility for obtaining non-symbolic traceback information, useful in various debugging situations. @node GNAT Traceback Symbolic g-trasym ads,GNAT UTF_32 g-table ads,GNAT Traceback g-traceb ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-traceback-symbolic-g-trasym-ads}@anchor{3cd}@anchor{gnat_rm/the_gnat_library id129}@anchor{3ce} +@anchor{gnat_rm/the_gnat_library gnat-traceback-symbolic-g-trasym-ads}@anchor{3d1}@anchor{gnat_rm/the_gnat_library id129}@anchor{3d2} @section @code{GNAT.Traceback.Symbolic} (@code{g-trasym.ads}) @@ -25058,7 +25085,7 @@ in various debugging situations. @geindex Trace back facilities @node GNAT UTF_32 g-table ads,GNAT Wide_Spelling_Checker g-u3spch ads,GNAT Traceback Symbolic g-trasym ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id130}@anchor{3cf}@anchor{gnat_rm/the_gnat_library gnat-utf-32-g-table-ads}@anchor{3d0} +@anchor{gnat_rm/the_gnat_library id130}@anchor{3d3}@anchor{gnat_rm/the_gnat_library gnat-utf-32-g-table-ads}@anchor{3d4} @section @code{GNAT.UTF_32} (@code{g-table.ads}) @@ -25077,7 +25104,7 @@ lower case to upper case fold routine corresponding to the Ada 2005 rules for identifier equivalence. @node GNAT Wide_Spelling_Checker g-u3spch ads,GNAT Wide_Spelling_Checker g-wispch ads,GNAT UTF_32 g-table ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-wide-spelling-checker-g-u3spch-ads}@anchor{3d1}@anchor{gnat_rm/the_gnat_library id131}@anchor{3d2} +@anchor{gnat_rm/the_gnat_library gnat-wide-spelling-checker-g-u3spch-ads}@anchor{3d5}@anchor{gnat_rm/the_gnat_library id131}@anchor{3d6} @section @code{GNAT.Wide_Spelling_Checker} (@code{g-u3spch.ads}) @@ -25090,7 +25117,7 @@ near misspelling of another wide wide string, where the strings are represented using the UTF_32_String type defined in System.Wch_Cnv. @node GNAT Wide_Spelling_Checker g-wispch ads,GNAT Wide_String_Split g-wistsp ads,GNAT Wide_Spelling_Checker g-u3spch ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-wide-spelling-checker-g-wispch-ads}@anchor{3d3}@anchor{gnat_rm/the_gnat_library id132}@anchor{3d4} +@anchor{gnat_rm/the_gnat_library gnat-wide-spelling-checker-g-wispch-ads}@anchor{3d7}@anchor{gnat_rm/the_gnat_library id132}@anchor{3d8} @section @code{GNAT.Wide_Spelling_Checker} (@code{g-wispch.ads}) @@ -25102,7 +25129,7 @@ Provides a function for determining whether one wide string is a plausible near misspelling of another wide string. @node GNAT Wide_String_Split g-wistsp ads,GNAT Wide_Wide_Spelling_Checker g-zspche ads,GNAT Wide_Spelling_Checker g-wispch ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id133}@anchor{3d5}@anchor{gnat_rm/the_gnat_library gnat-wide-string-split-g-wistsp-ads}@anchor{3d6} +@anchor{gnat_rm/the_gnat_library id133}@anchor{3d9}@anchor{gnat_rm/the_gnat_library gnat-wide-string-split-g-wistsp-ads}@anchor{3da} @section @code{GNAT.Wide_String_Split} (@code{g-wistsp.ads}) @@ -25116,7 +25143,7 @@ to the resulting slices. This package is instantiated from @code{GNAT.Array_Split}. @node GNAT Wide_Wide_Spelling_Checker g-zspche ads,GNAT Wide_Wide_String_Split g-zistsp ads,GNAT Wide_String_Split g-wistsp ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-wide-wide-spelling-checker-g-zspche-ads}@anchor{3d7}@anchor{gnat_rm/the_gnat_library id134}@anchor{3d8} +@anchor{gnat_rm/the_gnat_library gnat-wide-wide-spelling-checker-g-zspche-ads}@anchor{3db}@anchor{gnat_rm/the_gnat_library id134}@anchor{3dc} @section @code{GNAT.Wide_Wide_Spelling_Checker} (@code{g-zspche.ads}) @@ -25128,7 +25155,7 @@ Provides a function for determining whether one wide wide string is a plausible near misspelling of another wide wide string. @node GNAT Wide_Wide_String_Split g-zistsp ads,Interfaces C Extensions i-cexten ads,GNAT Wide_Wide_Spelling_Checker g-zspche ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-wide-wide-string-split-g-zistsp-ads}@anchor{3d9}@anchor{gnat_rm/the_gnat_library id135}@anchor{3da} +@anchor{gnat_rm/the_gnat_library gnat-wide-wide-string-split-g-zistsp-ads}@anchor{3dd}@anchor{gnat_rm/the_gnat_library id135}@anchor{3de} @section @code{GNAT.Wide_Wide_String_Split} (@code{g-zistsp.ads}) @@ -25142,7 +25169,7 @@ to the resulting slices. This package is instantiated from @code{GNAT.Array_Split}. @node Interfaces C Extensions i-cexten ads,Interfaces C Streams i-cstrea ads,GNAT Wide_Wide_String_Split g-zistsp ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library interfaces-c-extensions-i-cexten-ads}@anchor{3db}@anchor{gnat_rm/the_gnat_library id136}@anchor{3dc} +@anchor{gnat_rm/the_gnat_library interfaces-c-extensions-i-cexten-ads}@anchor{3df}@anchor{gnat_rm/the_gnat_library id136}@anchor{3e0} @section @code{Interfaces.C.Extensions} (@code{i-cexten.ads}) @@ -25153,7 +25180,7 @@ for use with either manually or automatically generated bindings to C libraries. @node Interfaces C Streams i-cstrea ads,Interfaces Packed_Decimal i-pacdec ads,Interfaces C Extensions i-cexten ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library interfaces-c-streams-i-cstrea-ads}@anchor{3dd}@anchor{gnat_rm/the_gnat_library id137}@anchor{3de} +@anchor{gnat_rm/the_gnat_library interfaces-c-streams-i-cstrea-ads}@anchor{3e1}@anchor{gnat_rm/the_gnat_library id137}@anchor{3e2} @section @code{Interfaces.C.Streams} (@code{i-cstrea.ads}) @@ -25166,7 +25193,7 @@ This package is a binding for the most commonly used operations on C streams. @node Interfaces Packed_Decimal i-pacdec ads,Interfaces VxWorks i-vxwork ads,Interfaces C Streams i-cstrea ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id138}@anchor{3df}@anchor{gnat_rm/the_gnat_library interfaces-packed-decimal-i-pacdec-ads}@anchor{3e0} +@anchor{gnat_rm/the_gnat_library id138}@anchor{3e3}@anchor{gnat_rm/the_gnat_library interfaces-packed-decimal-i-pacdec-ads}@anchor{3e4} @section @code{Interfaces.Packed_Decimal} (@code{i-pacdec.ads}) @@ -25181,7 +25208,7 @@ from a packed decimal format compatible with that used on IBM mainframes. @node Interfaces VxWorks i-vxwork ads,Interfaces VxWorks Int_Connection i-vxinco ads,Interfaces Packed_Decimal i-pacdec ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id139}@anchor{3e1}@anchor{gnat_rm/the_gnat_library interfaces-vxworks-i-vxwork-ads}@anchor{3e2} +@anchor{gnat_rm/the_gnat_library id139}@anchor{3e5}@anchor{gnat_rm/the_gnat_library interfaces-vxworks-i-vxwork-ads}@anchor{3e6} @section @code{Interfaces.VxWorks} (@code{i-vxwork.ads}) @@ -25197,7 +25224,7 @@ In particular, it interfaces with the VxWorks hardware interrupt facilities. @node Interfaces VxWorks Int_Connection i-vxinco ads,Interfaces VxWorks IO i-vxwoio ads,Interfaces VxWorks i-vxwork ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library interfaces-vxworks-int-connection-i-vxinco-ads}@anchor{3e3}@anchor{gnat_rm/the_gnat_library id140}@anchor{3e4} +@anchor{gnat_rm/the_gnat_library interfaces-vxworks-int-connection-i-vxinco-ads}@anchor{3e7}@anchor{gnat_rm/the_gnat_library id140}@anchor{3e8} @section @code{Interfaces.VxWorks.Int_Connection} (@code{i-vxinco.ads}) @@ -25213,7 +25240,7 @@ intConnect() with a custom routine for installing interrupt handlers. @node Interfaces VxWorks IO i-vxwoio ads,System Address_Image s-addima ads,Interfaces VxWorks Int_Connection i-vxinco ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library interfaces-vxworks-io-i-vxwoio-ads}@anchor{3e5}@anchor{gnat_rm/the_gnat_library id141}@anchor{3e6} +@anchor{gnat_rm/the_gnat_library interfaces-vxworks-io-i-vxwoio-ads}@anchor{3e9}@anchor{gnat_rm/the_gnat_library id141}@anchor{3ea} @section @code{Interfaces.VxWorks.IO} (@code{i-vxwoio.ads}) @@ -25236,7 +25263,7 @@ function codes. A particular use of this package is to enable the use of Get_Immediate under VxWorks. @node System Address_Image s-addima ads,System Assertions s-assert ads,Interfaces VxWorks IO i-vxwoio ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library system-address-image-s-addima-ads}@anchor{3e7}@anchor{gnat_rm/the_gnat_library id142}@anchor{3e8} +@anchor{gnat_rm/the_gnat_library system-address-image-s-addima-ads}@anchor{3eb}@anchor{gnat_rm/the_gnat_library id142}@anchor{3ec} @section @code{System.Address_Image} (@code{s-addima.ads}) @@ -25252,7 +25279,7 @@ function that gives an (implementation dependent) string which identifies an address. @node System Assertions s-assert ads,System Atomic_Counters s-atocou ads,System Address_Image s-addima ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library system-assertions-s-assert-ads}@anchor{3e9}@anchor{gnat_rm/the_gnat_library id143}@anchor{3ea} +@anchor{gnat_rm/the_gnat_library system-assertions-s-assert-ads}@anchor{3ed}@anchor{gnat_rm/the_gnat_library id143}@anchor{3ee} @section @code{System.Assertions} (@code{s-assert.ads}) @@ -25268,7 +25295,7 @@ by an run-time assertion failure, as well as the routine that is used internally to raise this assertion. @node System Atomic_Counters s-atocou ads,System Memory s-memory ads,System Assertions s-assert ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id144}@anchor{3eb}@anchor{gnat_rm/the_gnat_library system-atomic-counters-s-atocou-ads}@anchor{3ec} +@anchor{gnat_rm/the_gnat_library id144}@anchor{3ef}@anchor{gnat_rm/the_gnat_library system-atomic-counters-s-atocou-ads}@anchor{3f0} @section @code{System.Atomic_Counters} (@code{s-atocou.ads}) @@ -25282,7 +25309,7 @@ on most targets, including all Alpha, ia64, PowerPC, SPARC V9, x86, and x86_64 platforms. @node System Memory s-memory ads,System Multiprocessors s-multip ads,System Atomic_Counters s-atocou ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library system-memory-s-memory-ads}@anchor{3ed}@anchor{gnat_rm/the_gnat_library id145}@anchor{3ee} +@anchor{gnat_rm/the_gnat_library system-memory-s-memory-ads}@anchor{3f1}@anchor{gnat_rm/the_gnat_library id145}@anchor{3f2} @section @code{System.Memory} (@code{s-memory.ads}) @@ -25300,7 +25327,7 @@ calls to this unit may be made for low level allocation uses (for example see the body of @code{GNAT.Tables}). @node System Multiprocessors s-multip ads,System Multiprocessors Dispatching_Domains s-mudido ads,System Memory s-memory ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id146}@anchor{3ef}@anchor{gnat_rm/the_gnat_library system-multiprocessors-s-multip-ads}@anchor{3f0} +@anchor{gnat_rm/the_gnat_library id146}@anchor{3f3}@anchor{gnat_rm/the_gnat_library system-multiprocessors-s-multip-ads}@anchor{3f4} @section @code{System.Multiprocessors} (@code{s-multip.ads}) @@ -25313,7 +25340,7 @@ in GNAT we also make it available in Ada 95 and Ada 2005 (where it is technically an implementation-defined addition). @node System Multiprocessors Dispatching_Domains s-mudido ads,System Partition_Interface s-parint ads,System Multiprocessors s-multip ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library system-multiprocessors-dispatching-domains-s-mudido-ads}@anchor{3f1}@anchor{gnat_rm/the_gnat_library id147}@anchor{3f2} +@anchor{gnat_rm/the_gnat_library system-multiprocessors-dispatching-domains-s-mudido-ads}@anchor{3f5}@anchor{gnat_rm/the_gnat_library id147}@anchor{3f6} @section @code{System.Multiprocessors.Dispatching_Domains} (@code{s-mudido.ads}) @@ -25326,7 +25353,7 @@ in GNAT we also make it available in Ada 95 and Ada 2005 (where it is technically an implementation-defined addition). @node System Partition_Interface s-parint ads,System Pool_Global s-pooglo ads,System Multiprocessors Dispatching_Domains s-mudido ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id148}@anchor{3f3}@anchor{gnat_rm/the_gnat_library system-partition-interface-s-parint-ads}@anchor{3f4} +@anchor{gnat_rm/the_gnat_library id148}@anchor{3f7}@anchor{gnat_rm/the_gnat_library system-partition-interface-s-parint-ads}@anchor{3f8} @section @code{System.Partition_Interface} (@code{s-parint.ads}) @@ -25339,7 +25366,7 @@ is used primarily in a distribution context when using Annex E with @code{GLADE}. @node System Pool_Global s-pooglo ads,System Pool_Local s-pooloc ads,System Partition_Interface s-parint ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id149}@anchor{3f5}@anchor{gnat_rm/the_gnat_library system-pool-global-s-pooglo-ads}@anchor{3f6} +@anchor{gnat_rm/the_gnat_library id149}@anchor{3f9}@anchor{gnat_rm/the_gnat_library system-pool-global-s-pooglo-ads}@anchor{3fa} @section @code{System.Pool_Global} (@code{s-pooglo.ads}) @@ -25356,7 +25383,7 @@ declared. It uses malloc/free to allocate/free and does not attempt to do any automatic reclamation. @node System Pool_Local s-pooloc ads,System Restrictions s-restri ads,System Pool_Global s-pooglo ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library system-pool-local-s-pooloc-ads}@anchor{3f7}@anchor{gnat_rm/the_gnat_library id150}@anchor{3f8} +@anchor{gnat_rm/the_gnat_library system-pool-local-s-pooloc-ads}@anchor{3fb}@anchor{gnat_rm/the_gnat_library id150}@anchor{3fc} @section @code{System.Pool_Local} (@code{s-pooloc.ads}) @@ -25373,7 +25400,7 @@ a list of allocated blocks, so that all storage allocated for the pool can be freed automatically when the pool is finalized. @node System Restrictions s-restri ads,System Rident s-rident ads,System Pool_Local s-pooloc ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library system-restrictions-s-restri-ads}@anchor{3f9}@anchor{gnat_rm/the_gnat_library id151}@anchor{3fa} +@anchor{gnat_rm/the_gnat_library system-restrictions-s-restri-ads}@anchor{3fd}@anchor{gnat_rm/the_gnat_library id151}@anchor{3fe} @section @code{System.Restrictions} (@code{s-restri.ads}) @@ -25389,7 +25416,7 @@ compiler determined information on which restrictions are violated by one or more packages in the partition. @node System Rident s-rident ads,System Strings Stream_Ops s-ststop ads,System Restrictions s-restri ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library system-rident-s-rident-ads}@anchor{3fb}@anchor{gnat_rm/the_gnat_library id152}@anchor{3fc} +@anchor{gnat_rm/the_gnat_library system-rident-s-rident-ads}@anchor{3ff}@anchor{gnat_rm/the_gnat_library id152}@anchor{400} @section @code{System.Rident} (@code{s-rident.ads}) @@ -25405,7 +25432,7 @@ since the necessary instantiation is included in package System.Restrictions. @node System Strings Stream_Ops s-ststop ads,System Unsigned_Types s-unstyp ads,System Rident s-rident ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id153}@anchor{3fd}@anchor{gnat_rm/the_gnat_library system-strings-stream-ops-s-ststop-ads}@anchor{3fe} +@anchor{gnat_rm/the_gnat_library id153}@anchor{401}@anchor{gnat_rm/the_gnat_library system-strings-stream-ops-s-ststop-ads}@anchor{402} @section @code{System.Strings.Stream_Ops} (@code{s-ststop.ads}) @@ -25421,7 +25448,7 @@ stream attributes are applied to string types, but the subprograms in this package can be used directly by application programs. @node System Unsigned_Types s-unstyp ads,System Wch_Cnv s-wchcnv ads,System Strings Stream_Ops s-ststop ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library system-unsigned-types-s-unstyp-ads}@anchor{3ff}@anchor{gnat_rm/the_gnat_library id154}@anchor{400} +@anchor{gnat_rm/the_gnat_library system-unsigned-types-s-unstyp-ads}@anchor{403}@anchor{gnat_rm/the_gnat_library id154}@anchor{404} @section @code{System.Unsigned_Types} (@code{s-unstyp.ads}) @@ -25434,7 +25461,7 @@ also contains some related definitions for other specialized types used by the compiler in connection with packed array types. @node System Wch_Cnv s-wchcnv ads,System Wch_Con s-wchcon ads,System Unsigned_Types s-unstyp ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library system-wch-cnv-s-wchcnv-ads}@anchor{401}@anchor{gnat_rm/the_gnat_library id155}@anchor{402} +@anchor{gnat_rm/the_gnat_library system-wch-cnv-s-wchcnv-ads}@anchor{405}@anchor{gnat_rm/the_gnat_library id155}@anchor{406} @section @code{System.Wch_Cnv} (@code{s-wchcnv.ads}) @@ -25455,7 +25482,7 @@ encoding method. It uses definitions in package @code{System.Wch_Con}. @node System Wch_Con s-wchcon ads,,System Wch_Cnv s-wchcnv ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id156}@anchor{403}@anchor{gnat_rm/the_gnat_library system-wch-con-s-wchcon-ads}@anchor{404} +@anchor{gnat_rm/the_gnat_library id156}@anchor{407}@anchor{gnat_rm/the_gnat_library system-wch-con-s-wchcon-ads}@anchor{408} @section @code{System.Wch_Con} (@code{s-wchcon.ads}) @@ -25467,7 +25494,7 @@ in ordinary strings. These definitions are used by the package @code{System.Wch_Cnv}. @node Interfacing to Other Languages,Specialized Needs Annexes,The GNAT Library,Top -@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-other-languages}@anchor{11}@anchor{gnat_rm/interfacing_to_other_languages doc}@anchor{405}@anchor{gnat_rm/interfacing_to_other_languages id1}@anchor{406} +@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-other-languages}@anchor{11}@anchor{gnat_rm/interfacing_to_other_languages doc}@anchor{409}@anchor{gnat_rm/interfacing_to_other_languages id1}@anchor{40a} @chapter Interfacing to Other Languages @@ -25485,7 +25512,7 @@ provided. @end menu @node Interfacing to C,Interfacing to C++,,Interfacing to Other Languages -@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-c}@anchor{407}@anchor{gnat_rm/interfacing_to_other_languages id2}@anchor{408} +@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-c}@anchor{40b}@anchor{gnat_rm/interfacing_to_other_languages id2}@anchor{40c} @section Interfacing to C @@ -25625,7 +25652,7 @@ of the length corresponding to the @code{type'Size} value in Ada. @end itemize @node Interfacing to C++,Interfacing to COBOL,Interfacing to C,Interfacing to Other Languages -@anchor{gnat_rm/interfacing_to_other_languages id4}@anchor{409}@anchor{gnat_rm/interfacing_to_other_languages id3}@anchor{49} +@anchor{gnat_rm/interfacing_to_other_languages id4}@anchor{40d}@anchor{gnat_rm/interfacing_to_other_languages id3}@anchor{49} @section Interfacing to C++ @@ -25682,7 +25709,7 @@ The @code{External_Name} is the name of the C++ RTTI symbol. You can then cover a specific C++ exception in an exception handler. @node Interfacing to COBOL,Interfacing to Fortran,Interfacing to C++,Interfacing to Other Languages -@anchor{gnat_rm/interfacing_to_other_languages id5}@anchor{40a}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-cobol}@anchor{40b} +@anchor{gnat_rm/interfacing_to_other_languages id5}@anchor{40e}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-cobol}@anchor{40f} @section Interfacing to COBOL @@ -25690,7 +25717,7 @@ Interfacing to COBOL is achieved as described in section B.4 of the Ada Reference Manual. @node Interfacing to Fortran,Interfacing to non-GNAT Ada code,Interfacing to COBOL,Interfacing to Other Languages -@anchor{gnat_rm/interfacing_to_other_languages id6}@anchor{40c}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-fortran}@anchor{40d} +@anchor{gnat_rm/interfacing_to_other_languages id6}@anchor{410}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-fortran}@anchor{411} @section Interfacing to Fortran @@ -25700,7 +25727,7 @@ multi-dimensional array causes the array to be stored in column-major order as required for convenient interface to Fortran. @node Interfacing to non-GNAT Ada code,,Interfacing to Fortran,Interfacing to Other Languages -@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-non-gnat-ada-code}@anchor{40e}@anchor{gnat_rm/interfacing_to_other_languages id7}@anchor{40f} +@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-non-gnat-ada-code}@anchor{412}@anchor{gnat_rm/interfacing_to_other_languages id7}@anchor{413} @section Interfacing to non-GNAT Ada code @@ -25724,7 +25751,7 @@ values or simple record types without variants, or simple array types with fixed bounds. @node Specialized Needs Annexes,Implementation of Specific Ada Features,Interfacing to Other Languages,Top -@anchor{gnat_rm/specialized_needs_annexes specialized-needs-annexes}@anchor{12}@anchor{gnat_rm/specialized_needs_annexes doc}@anchor{410}@anchor{gnat_rm/specialized_needs_annexes id1}@anchor{411} +@anchor{gnat_rm/specialized_needs_annexes specialized-needs-annexes}@anchor{12}@anchor{gnat_rm/specialized_needs_annexes doc}@anchor{414}@anchor{gnat_rm/specialized_needs_annexes id1}@anchor{415} @chapter Specialized Needs Annexes @@ -25765,7 +25792,7 @@ in Ada 2005) is fully implemented. @end table @node Implementation of Specific Ada Features,Implementation of Ada 2012 Features,Specialized Needs Annexes,Top -@anchor{gnat_rm/implementation_of_specific_ada_features implementation-of-specific-ada-features}@anchor{13}@anchor{gnat_rm/implementation_of_specific_ada_features doc}@anchor{412}@anchor{gnat_rm/implementation_of_specific_ada_features id1}@anchor{413} +@anchor{gnat_rm/implementation_of_specific_ada_features implementation-of-specific-ada-features}@anchor{13}@anchor{gnat_rm/implementation_of_specific_ada_features doc}@anchor{416}@anchor{gnat_rm/implementation_of_specific_ada_features id1}@anchor{417} @chapter Implementation of Specific Ada Features @@ -25783,7 +25810,7 @@ facilities. @end menu @node Machine Code Insertions,GNAT Implementation of Tasking,,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features machine-code-insertions}@anchor{168}@anchor{gnat_rm/implementation_of_specific_ada_features id2}@anchor{414} +@anchor{gnat_rm/implementation_of_specific_ada_features machine-code-insertions}@anchor{16c}@anchor{gnat_rm/implementation_of_specific_ada_features id2}@anchor{418} @section Machine Code Insertions @@ -25951,7 +25978,7 @@ according to normal visibility rules. In particular if there is no qualification is required. @node GNAT Implementation of Tasking,GNAT Implementation of Shared Passive Packages,Machine Code Insertions,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features id3}@anchor{415}@anchor{gnat_rm/implementation_of_specific_ada_features gnat-implementation-of-tasking}@anchor{416} +@anchor{gnat_rm/implementation_of_specific_ada_features id3}@anchor{419}@anchor{gnat_rm/implementation_of_specific_ada_features gnat-implementation-of-tasking}@anchor{41a} @section GNAT Implementation of Tasking @@ -25967,7 +25994,7 @@ to compliance with the Real-Time Systems Annex. @end menu @node Mapping Ada Tasks onto the Underlying Kernel Threads,Ensuring Compliance with the Real-Time Annex,,GNAT Implementation of Tasking -@anchor{gnat_rm/implementation_of_specific_ada_features mapping-ada-tasks-onto-the-underlying-kernel-threads}@anchor{417}@anchor{gnat_rm/implementation_of_specific_ada_features id4}@anchor{418} +@anchor{gnat_rm/implementation_of_specific_ada_features mapping-ada-tasks-onto-the-underlying-kernel-threads}@anchor{41b}@anchor{gnat_rm/implementation_of_specific_ada_features id4}@anchor{41c} @subsection Mapping Ada Tasks onto the Underlying Kernel Threads @@ -26036,7 +26063,7 @@ support this functionality when the parent contains more than one task. @geindex Forking a new process @node Ensuring Compliance with the Real-Time Annex,Support for Locking Policies,Mapping Ada Tasks onto the Underlying Kernel Threads,GNAT Implementation of Tasking -@anchor{gnat_rm/implementation_of_specific_ada_features id5}@anchor{419}@anchor{gnat_rm/implementation_of_specific_ada_features ensuring-compliance-with-the-real-time-annex}@anchor{41a} +@anchor{gnat_rm/implementation_of_specific_ada_features id5}@anchor{41d}@anchor{gnat_rm/implementation_of_specific_ada_features ensuring-compliance-with-the-real-time-annex}@anchor{41e} @subsection Ensuring Compliance with the Real-Time Annex @@ -26087,7 +26114,7 @@ placed at the end. @c Support_for_Locking_Policies @node Support for Locking Policies,,Ensuring Compliance with the Real-Time Annex,GNAT Implementation of Tasking -@anchor{gnat_rm/implementation_of_specific_ada_features support-for-locking-policies}@anchor{41b} +@anchor{gnat_rm/implementation_of_specific_ada_features support-for-locking-policies}@anchor{41f} @subsection Support for Locking Policies @@ -26121,7 +26148,7 @@ then ceiling locking is used. Otherwise, the @code{Ceiling_Locking} policy is ignored. @node GNAT Implementation of Shared Passive Packages,Code Generation for Array Aggregates,GNAT Implementation of Tasking,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features id6}@anchor{41c}@anchor{gnat_rm/implementation_of_specific_ada_features gnat-implementation-of-shared-passive-packages}@anchor{41d} +@anchor{gnat_rm/implementation_of_specific_ada_features id6}@anchor{420}@anchor{gnat_rm/implementation_of_specific_ada_features gnat-implementation-of-shared-passive-packages}@anchor{421} @section GNAT Implementation of Shared Passive Packages @@ -26222,7 +26249,7 @@ GNAT supports shared passive packages on all platforms except for OpenVMS. @node Code Generation for Array Aggregates,The Size of Discriminated Records with Default Discriminants,GNAT Implementation of Shared Passive Packages,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features code-generation-for-array-aggregates}@anchor{41e}@anchor{gnat_rm/implementation_of_specific_ada_features id7}@anchor{41f} +@anchor{gnat_rm/implementation_of_specific_ada_features code-generation-for-array-aggregates}@anchor{422}@anchor{gnat_rm/implementation_of_specific_ada_features id7}@anchor{423} @section Code Generation for Array Aggregates @@ -26253,7 +26280,7 @@ component values and static subtypes also lead to simpler code. @end menu @node Static constant aggregates with static bounds,Constant aggregates with unconstrained nominal types,,Code Generation for Array Aggregates -@anchor{gnat_rm/implementation_of_specific_ada_features static-constant-aggregates-with-static-bounds}@anchor{420}@anchor{gnat_rm/implementation_of_specific_ada_features id8}@anchor{421} +@anchor{gnat_rm/implementation_of_specific_ada_features static-constant-aggregates-with-static-bounds}@anchor{424}@anchor{gnat_rm/implementation_of_specific_ada_features id8}@anchor{425} @subsection Static constant aggregates with static bounds @@ -26300,7 +26327,7 @@ Zero2: constant two_dim := (others => (others => 0)); @end example @node Constant aggregates with unconstrained nominal types,Aggregates with static bounds,Static constant aggregates with static bounds,Code Generation for Array Aggregates -@anchor{gnat_rm/implementation_of_specific_ada_features constant-aggregates-with-unconstrained-nominal-types}@anchor{422}@anchor{gnat_rm/implementation_of_specific_ada_features id9}@anchor{423} +@anchor{gnat_rm/implementation_of_specific_ada_features constant-aggregates-with-unconstrained-nominal-types}@anchor{426}@anchor{gnat_rm/implementation_of_specific_ada_features id9}@anchor{427} @subsection Constant aggregates with unconstrained nominal types @@ -26315,7 +26342,7 @@ Cr_Unc : constant One_Unc := (12,24,36); @end example @node Aggregates with static bounds,Aggregates with nonstatic bounds,Constant aggregates with unconstrained nominal types,Code Generation for Array Aggregates -@anchor{gnat_rm/implementation_of_specific_ada_features id10}@anchor{424}@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-with-static-bounds}@anchor{425} +@anchor{gnat_rm/implementation_of_specific_ada_features id10}@anchor{428}@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-with-static-bounds}@anchor{429} @subsection Aggregates with static bounds @@ -26343,7 +26370,7 @@ end loop; @end example @node Aggregates with nonstatic bounds,Aggregates in assignment statements,Aggregates with static bounds,Code Generation for Array Aggregates -@anchor{gnat_rm/implementation_of_specific_ada_features id11}@anchor{426}@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-with-nonstatic-bounds}@anchor{427} +@anchor{gnat_rm/implementation_of_specific_ada_features id11}@anchor{42a}@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-with-nonstatic-bounds}@anchor{42b} @subsection Aggregates with nonstatic bounds @@ -26354,7 +26381,7 @@ have to be applied to sub-arrays individually, if they do not have statically compatible subtypes. @node Aggregates in assignment statements,,Aggregates with nonstatic bounds,Code Generation for Array Aggregates -@anchor{gnat_rm/implementation_of_specific_ada_features id12}@anchor{428}@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-in-assignment-statements}@anchor{429} +@anchor{gnat_rm/implementation_of_specific_ada_features id12}@anchor{42c}@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-in-assignment-statements}@anchor{42d} @subsection Aggregates in assignment statements @@ -26396,7 +26423,7 @@ a temporary (created either by the front-end or the code generator) and then that temporary will be copied onto the target. @node The Size of Discriminated Records with Default Discriminants,Strict Conformance to the Ada Reference Manual,Code Generation for Array Aggregates,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features id13}@anchor{42a}@anchor{gnat_rm/implementation_of_specific_ada_features the-size-of-discriminated-records-with-default-discriminants}@anchor{42b} +@anchor{gnat_rm/implementation_of_specific_ada_features id13}@anchor{42e}@anchor{gnat_rm/implementation_of_specific_ada_features the-size-of-discriminated-records-with-default-discriminants}@anchor{42f} @section The Size of Discriminated Records with Default Discriminants @@ -26476,7 +26503,7 @@ say) must be consistent, so it is imperative that the object, once created, remain invariant. @node Strict Conformance to the Ada Reference Manual,,The Size of Discriminated Records with Default Discriminants,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features strict-conformance-to-the-ada-reference-manual}@anchor{42c}@anchor{gnat_rm/implementation_of_specific_ada_features id14}@anchor{42d} +@anchor{gnat_rm/implementation_of_specific_ada_features strict-conformance-to-the-ada-reference-manual}@anchor{430}@anchor{gnat_rm/implementation_of_specific_ada_features id14}@anchor{431} @section Strict Conformance to the Ada Reference Manual @@ -26503,7 +26530,7 @@ behavior (although at the cost of a significant performance penalty), so infinite and NaN values are properly generated. @node Implementation of Ada 2012 Features,Obsolescent Features,Implementation of Specific Ada Features,Top -@anchor{gnat_rm/implementation_of_ada_2012_features doc}@anchor{42e}@anchor{gnat_rm/implementation_of_ada_2012_features implementation-of-ada-2012-features}@anchor{14}@anchor{gnat_rm/implementation_of_ada_2012_features id1}@anchor{42f} +@anchor{gnat_rm/implementation_of_ada_2012_features doc}@anchor{432}@anchor{gnat_rm/implementation_of_ada_2012_features implementation-of-ada-2012-features}@anchor{14}@anchor{gnat_rm/implementation_of_ada_2012_features id1}@anchor{433} @chapter Implementation of Ada 2012 Features @@ -28669,7 +28696,7 @@ RM References: H.04 (8/1) @end itemize @node Obsolescent Features,Compatibility and Porting Guide,Implementation of Ada 2012 Features,Top -@anchor{gnat_rm/obsolescent_features id1}@anchor{430}@anchor{gnat_rm/obsolescent_features doc}@anchor{431}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{15} +@anchor{gnat_rm/obsolescent_features id1}@anchor{434}@anchor{gnat_rm/obsolescent_features doc}@anchor{435}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{15} @chapter Obsolescent Features @@ -28688,7 +28715,7 @@ compatibility purposes. @end menu @node pragma No_Run_Time,pragma Ravenscar,,Obsolescent Features -@anchor{gnat_rm/obsolescent_features id2}@anchor{432}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{433} +@anchor{gnat_rm/obsolescent_features id2}@anchor{436}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{437} @section pragma No_Run_Time @@ -28701,7 +28728,7 @@ preferred usage is to use an appropriately configured run-time that includes just those features that are to be made accessible. @node pragma Ravenscar,pragma Restricted_Run_Time,pragma No_Run_Time,Obsolescent Features -@anchor{gnat_rm/obsolescent_features id3}@anchor{434}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{435} +@anchor{gnat_rm/obsolescent_features id3}@anchor{438}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{439} @section pragma Ravenscar @@ -28710,7 +28737,7 @@ The pragma @code{Ravenscar} has exactly the same effect as pragma is part of the new Ada 2005 standard. @node pragma Restricted_Run_Time,pragma Task_Info,pragma Ravenscar,Obsolescent Features -@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{436}@anchor{gnat_rm/obsolescent_features id4}@anchor{437} +@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{43a}@anchor{gnat_rm/obsolescent_features id4}@anchor{43b} @section pragma Restricted_Run_Time @@ -28720,7 +28747,7 @@ preferred since the Ada 2005 pragma @code{Profile} is intended for this kind of implementation dependent addition. @node pragma Task_Info,package System Task_Info s-tasinf ads,pragma Restricted_Run_Time,Obsolescent Features -@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{438}@anchor{gnat_rm/obsolescent_features id5}@anchor{439} +@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{43c}@anchor{gnat_rm/obsolescent_features id5}@anchor{43d} @section pragma Task_Info @@ -28746,7 +28773,7 @@ in the spec of package System.Task_Info in the runtime library. @node package System Task_Info s-tasinf ads,,pragma Task_Info,Obsolescent Features -@anchor{gnat_rm/obsolescent_features package-system-task-info}@anchor{43a}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{43b} +@anchor{gnat_rm/obsolescent_features package-system-task-info}@anchor{43e}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{43f} @section package System.Task_Info (@code{s-tasinf.ads}) @@ -28756,7 +28783,7 @@ to support the @code{Task_Info} pragma. The predefined Ada package standard replacement for GNAT's @code{Task_Info} functionality. @node Compatibility and Porting Guide,GNU Free Documentation License,Obsolescent Features,Top -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{16}@anchor{gnat_rm/compatibility_and_porting_guide doc}@anchor{43c}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{43d} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{16}@anchor{gnat_rm/compatibility_and_porting_guide doc}@anchor{440}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{441} @chapter Compatibility and Porting Guide @@ -28778,7 +28805,7 @@ applications developed in other Ada environments. @end menu @node Writing Portable Fixed-Point Declarations,Compatibility with Ada 83,,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide id2}@anchor{43e}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{43f} +@anchor{gnat_rm/compatibility_and_porting_guide id2}@anchor{442}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{443} @section Writing Portable Fixed-Point Declarations @@ -28900,7 +28927,7 @@ If you follow this scheme you will be guaranteed that your fixed-point types will be portable. @node Compatibility with Ada 83,Compatibility between Ada 95 and Ada 2005,Writing Portable Fixed-Point Declarations,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-ada-83}@anchor{440}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{441} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-ada-83}@anchor{444}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{445} @section Compatibility with Ada 83 @@ -28928,7 +28955,7 @@ following subsections treat the most likely issues to be encountered. @end menu @node Legal Ada 83 programs that are illegal in Ada 95,More deterministic semantics,,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide id4}@anchor{442}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{443} +@anchor{gnat_rm/compatibility_and_porting_guide id4}@anchor{446}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{447} @subsection Legal Ada 83 programs that are illegal in Ada 95 @@ -29028,7 +29055,7 @@ the fix is usually simply to add the @code{(<>)} to the generic declaration. @end itemize @node More deterministic semantics,Changed semantics,Legal Ada 83 programs that are illegal in Ada 95,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{444}@anchor{gnat_rm/compatibility_and_porting_guide id5}@anchor{445} +@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{448}@anchor{gnat_rm/compatibility_and_porting_guide id5}@anchor{449} @subsection More deterministic semantics @@ -29056,7 +29083,7 @@ which open select branches are executed. @end itemize @node Changed semantics,Other language compatibility issues,More deterministic semantics,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{446}@anchor{gnat_rm/compatibility_and_porting_guide changed-semantics}@anchor{447} +@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{44a}@anchor{gnat_rm/compatibility_and_porting_guide changed-semantics}@anchor{44b} @subsection Changed semantics @@ -29098,7 +29125,7 @@ covers only the restricted range. @end itemize @node Other language compatibility issues,,Changed semantics,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{448}@anchor{gnat_rm/compatibility_and_porting_guide id7}@anchor{449} +@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{44c}@anchor{gnat_rm/compatibility_and_porting_guide id7}@anchor{44d} @subsection Other language compatibility issues @@ -29131,7 +29158,7 @@ include @code{pragma Interface} and the floating point type attributes @end itemize @node Compatibility between Ada 95 and Ada 2005,Implementation-dependent characteristics,Compatibility with Ada 83,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-between-ada-95-and-ada-2005}@anchor{44a}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{44b} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-between-ada-95-and-ada-2005}@anchor{44e}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{44f} @section Compatibility between Ada 95 and Ada 2005 @@ -29203,7 +29230,7 @@ can declare a function returning a value from an anonymous access type. @end itemize @node Implementation-dependent characteristics,Compatibility with Other Ada Systems,Compatibility between Ada 95 and Ada 2005,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{44c}@anchor{gnat_rm/compatibility_and_porting_guide id9}@anchor{44d} +@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{450}@anchor{gnat_rm/compatibility_and_porting_guide id9}@anchor{451} @section Implementation-dependent characteristics @@ -29226,7 +29253,7 @@ transition from certain Ada 83 compilers. @end menu @node Implementation-defined pragmas,Implementation-defined attributes,,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{44e}@anchor{gnat_rm/compatibility_and_porting_guide id10}@anchor{44f} +@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{452}@anchor{gnat_rm/compatibility_and_porting_guide id10}@anchor{453} @subsection Implementation-defined pragmas @@ -29248,7 +29275,7 @@ avoiding compiler rejection of units that contain such pragmas; they are not relevant in a GNAT context and hence are not otherwise implemented. @node Implementation-defined attributes,Libraries,Implementation-defined pragmas,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide id11}@anchor{450}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{451} +@anchor{gnat_rm/compatibility_and_porting_guide id11}@anchor{454}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{455} @subsection Implementation-defined attributes @@ -29262,7 +29289,7 @@ Ada 83, GNAT supplies the attributes @code{Bit}, @code{Machine_Size} and @code{Type_Class}. @node Libraries,Elaboration order,Implementation-defined attributes,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{452}@anchor{gnat_rm/compatibility_and_porting_guide id12}@anchor{453} +@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{456}@anchor{gnat_rm/compatibility_and_porting_guide id12}@anchor{457} @subsection Libraries @@ -29291,7 +29318,7 @@ be preferable to retrofit the application using modular types. @end itemize @node Elaboration order,Target-specific aspects,Libraries,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide elaboration-order}@anchor{454}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{455} +@anchor{gnat_rm/compatibility_and_porting_guide elaboration-order}@anchor{458}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{459} @subsection Elaboration order @@ -29327,7 +29354,7 @@ pragmas either globally (as an effect of the @emph{-gnatE} switch) or locally @end itemize @node Target-specific aspects,,Elaboration order,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{456}@anchor{gnat_rm/compatibility_and_porting_guide id14}@anchor{457} +@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{45a}@anchor{gnat_rm/compatibility_and_porting_guide id14}@anchor{45b} @subsection Target-specific aspects @@ -29340,10 +29367,10 @@ on the robustness of the original design. Moreover, Ada 95 (and thus Ada 2005 and Ada 2012) are sometimes incompatible with typical Ada 83 compiler practices regarding implicit packing, the meaning of the Size attribute, and the size of access values. -GNAT's approach to these issues is described in @ref{458,,Representation Clauses}. +GNAT's approach to these issues is described in @ref{45c,,Representation Clauses}. @node Compatibility with Other Ada Systems,Representation Clauses,Implementation-dependent characteristics,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{459}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-other-ada-systems}@anchor{45a} +@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{45d}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-other-ada-systems}@anchor{45e} @section Compatibility with Other Ada Systems @@ -29386,7 +29413,7 @@ far beyond this minimal set, as described in the next section. @end itemize @node Representation Clauses,Compatibility with HP Ada 83,Compatibility with Other Ada Systems,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{458}@anchor{gnat_rm/compatibility_and_porting_guide id16}@anchor{45b} +@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{45c}@anchor{gnat_rm/compatibility_and_porting_guide id16}@anchor{45f} @section Representation Clauses @@ -29479,7 +29506,7 @@ with thin pointers. @end itemize @node Compatibility with HP Ada 83,,Representation Clauses,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-hp-ada-83}@anchor{45c}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{45d} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-hp-ada-83}@anchor{460}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{461} @section Compatibility with HP Ada 83 @@ -29509,7 +29536,7 @@ extension of package System. @end itemize @node GNU Free Documentation License,Index,Compatibility and Porting Guide,Top -@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license doc}@anchor{45e}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{45f} +@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license doc}@anchor{462}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{463} @chapter GNU Free Documentation License diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index ea4b06b..9042b97 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -1418,6 +1418,7 @@ begin | Pragma_Max_Queue_Length | Pragma_Memory_Size | Pragma_No_Body + | Pragma_No_Caching | Pragma_No_Component_Reordering | Pragma_No_Elaboration_Code_All | Pragma_No_Heap_Finalization diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index bf80200..5ec3487 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -2824,7 +2824,7 @@ package body Sem_Ch13 is Insert_Pragma (Aitem); goto Continue; - -- Aspect Effecitve_Reads is never delayed because it is + -- Aspect Effective_Reads is never delayed because it is -- equivalent to a source pragma which appears after the -- related object declaration. @@ -3027,6 +3027,21 @@ package body Sem_Ch13 is Insert_Pragma (Aitem); goto Continue; + -- Aspect No_Caching is never delayed because it is equivalent + -- to a source pragma which appears after the related object + -- declaration. + + when Aspect_No_Caching => + Make_Aitem_Pragma + (Pragma_Argument_Associations => New_List ( + Make_Pragma_Argument_Association (Loc, + Expression => Relocate_Node (Expr))), + Pragma_Name => Name_No_Caching); + + Decorate (Aspect, Aitem); + Insert_Pragma (Aitem); + goto Continue; + -- Obsolescent when Aspect_Obsolescent => declare @@ -9637,6 +9652,7 @@ package body Sem_Ch13 is | Aspect_Initializes | Aspect_Max_Entry_Queue_Depth | Aspect_Max_Queue_Length + | Aspect_No_Caching | Aspect_Obsolescent | Aspect_Part_Of | Aspect_Post diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 1a2a759..599ac4c 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -2064,6 +2064,7 @@ package body Sem_Prag is (N : Node_Id; Expr_Val : out Boolean) is + Prag_Id : constant Pragma_Id := Get_Pragma_Id (Pragma_Name (N)); Arg1 : constant Node_Id := First (Pragma_Argument_Associations (N)); Obj_Decl : constant Node_Id := Find_Related_Context (N); @@ -2090,9 +2091,28 @@ package body Sem_Prag is -- pragma Async_Readers (Obj); -- pragma Volatile (Obj); - if not Is_Effectively_Volatile (Obj_Id) then - SPARK_Msg_N - ("external property % must apply to a volatile object", N); + if Prag_Id /= Pragma_No_Caching + and then not Is_Effectively_Volatile (Obj_Id) + then + if No_Caching_Enabled (Obj_Id) then + SPARK_Msg_N + ("illegal combination of external property % and property " + & """No_Caching"" (SPARK RM 7.1.2(6))", N); + else + SPARK_Msg_N + ("external property % must apply to a volatile object", N); + end if; + + -- Pragma No_Caching should only apply to volatile variables of + -- a non-effectively volatile type (SPARK RM 7.1.2). + + elsif Prag_Id = Pragma_No_Caching then + if Is_Effectively_Volatile (Etype (Obj_Id)) then + SPARK_Msg_N ("property % must not apply to an object of " + & "an effectively volatile type", N); + elsif not Is_Volatile (Obj_Id) then + SPARK_Msg_N ("property % must apply to a volatile object", N); + end if; end if; -- Ensure that the Boolean expression (if present) is static. A missing @@ -13618,17 +13638,20 @@ package body Sem_Prag is ------------------------------------------------------------------ -- Async_Readers/Async_Writers/Effective_Reads/Effective_Writes -- + -- No_Caching -- ------------------------------------------------------------------ -- pragma Async_Readers [ (boolean_EXPRESSION) ]; -- pragma Async_Writers [ (boolean_EXPRESSION) ]; -- pragma Effective_Reads [ (boolean_EXPRESSION) ]; -- pragma Effective_Writes [ (boolean_EXPRESSION) ]; + -- pragma No_Caching [ (boolean_EXPRESSION) ]; when Pragma_Async_Readers | Pragma_Async_Writers | Pragma_Effective_Reads | Pragma_Effective_Writes + | Pragma_No_Caching => Async_Effective : declare Obj_Decl : Node_Id; @@ -31038,12 +31061,13 @@ package body Sem_Prag is Pragma_Max_Entry_Queue_Depth => 0, Pragma_Max_Queue_Length => 0, Pragma_Memory_Size => 0, - Pragma_No_Return => 0, Pragma_No_Body => 0, + Pragma_No_Caching => 0, Pragma_No_Component_Reordering => -1, Pragma_No_Elaboration_Code_All => 0, Pragma_No_Heap_Finalization => 0, Pragma_No_Inline => 0, + Pragma_No_Return => 0, Pragma_No_Run_Time => -1, Pragma_No_Strict_Aliasing => -1, Pragma_No_Tagged_Streams => 0, diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads index 25353b7..941a723 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -218,8 +218,9 @@ package Sem_Prag is (N : Node_Id; Expr_Val : out Boolean); -- Perform full analysis of delayed pragmas Async_Readers, Async_Writers, - -- Effective_Reads and Effective_Writes. Flag Expr_Val contains the Boolean - -- argument of the pragma or a default True if no argument is present. + -- Effective_Reads, Effective_Writes and No_Caching. Flag Expr_Val contains + -- the Boolean argument of the pragma or a default True if no argument + -- is present. procedure Analyze_Global_In_Decl_Part (N : Node_Id); -- Perform full analysis of delayed pragma Global. This routine is also diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index b56fa86..42085c7 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -14605,8 +14605,11 @@ package body Sem_Util is -- Otherwise Id denotes an object else + -- A volatile object for which No_Caching is enabled is not + -- effectively volatile. + return - Is_Volatile (Id) + (Is_Volatile (Id) and then not No_Caching_Enabled (Id)) or else Has_Volatile_Components (Id) or else Is_Effectively_Volatile (Etype (Id)); end if; @@ -21652,6 +21655,38 @@ package body Sem_Util is end if; end New_Requires_Transient_Scope; + ------------------------ + -- No_Caching_Enabled -- + ------------------------ + + function No_Caching_Enabled (Id : Entity_Id) return Boolean is + Prag : constant Node_Id := Get_Pragma (Id, Pragma_No_Caching); + Arg1 : Node_Id; + + begin + if Present (Prag) then + Arg1 := First (Pragma_Argument_Associations (Prag)); + + -- The pragma has an optional Boolean expression, the related + -- property is enabled only when the expression evaluates to True. + + if Present (Arg1) then + return Is_True (Expr_Value (Get_Pragma_Arg (Arg1))); + + -- Otherwise the lack of expression enables the property by + -- default. + + else + return True; + end if; + + -- The property was never set in the first place + + else + return False; + end if; + end No_Caching_Enabled; + -------------------------- -- No_Heap_Finalization -- -------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 2c1f8a8..1d3fcbf 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1682,7 +1682,7 @@ package Sem_Util is function Is_Effectively_Volatile (Id : Entity_Id) return Boolean; -- Determine whether a type or object denoted by entity Id is effectively -- volatile (SPARK RM 7.1.2). To qualify as such, the entity must be either - -- * Volatile + -- * Volatile without No_Caching -- * An array type subject to aspect Volatile_Components -- * An array type whose component type is effectively volatile -- * A protected type @@ -2387,6 +2387,11 @@ package Sem_Util is -- and possibly Next_Global a number of times. Returns the next global item -- with the same mode. + function No_Caching_Enabled (Id : Entity_Id) return Boolean; + -- Given the entity of a variable, determine whether Id is subject to + -- volatility property No_Caching and if it is, the related expression + -- evaluates to True. + function No_Heap_Finalization (Typ : Entity_Id) return Boolean; -- Determine whether type Typ is subject to pragma No_Heap_Finalization diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 2715310..ef6b17c 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -596,6 +596,7 @@ package Snames is Name_Max_Queue_Length : constant Name_Id := N + $; -- GNAT Name_Memory_Size : constant Name_Id := N + $; -- Ada 83 Name_No_Body : constant Name_Id := N + $; -- GNAT + Name_No_Caching : constant Name_Id := N + $; -- GNAT Name_No_Elaboration_Code_All : constant Name_Id := N + $; -- GNAT Name_No_Inline : constant Name_Id := N + $; -- GNAT Name_No_Return : constant Name_Id := N + $; -- Ada 05 @@ -2009,6 +2010,7 @@ package Snames is Pragma_Max_Queue_Length, Pragma_Memory_Size, Pragma_No_Body, + Pragma_No_Caching, Pragma_No_Elaboration_Code_All, Pragma_No_Inline, Pragma_No_Return, -- cgit v1.1 From 651c9c1e4b1bd2369ced718599ad1ac370aa37cd Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Mon, 12 Aug 2019 08:59:58 +0000 Subject: [Ada] Suppress_Initialization not respected for private subtypes The compiler fails to suppress initialization on a variable of a subtype of a private type (such as System.Address) even though the subtype has aspect Suppress_Initialization. This can lead to errors on object declarations specified with Thread_Local_Storage when Initialize_Scalars is applied (as well as leading to default initialization when it shouldn't). 2019-08-12 Gary Dismukes gcc/ada/ * sem_prag.adb (Analyze_Pragma, Pragma_Suppress_Initialization): For private types, set the Suppress_Initialization flag on the Full_View of the entity rather than the entity's base type. gcc/testsuite/ * gnat.dg/suppress_initialization2.adb, gnat.dg/suppress_initialization2.ads: New testcase. From-SVN: r274293 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/sem_prag.adb | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 78d78cc..4e76edf 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-12 Gary Dismukes + + * sem_prag.adb (Analyze_Pragma, Pragma_Suppress_Initialization): + For private types, set the Suppress_Initialization flag on the + Full_View of the entity rather than the entity's base type. + 2019-08-12 Yannick Moy * aspects.adb, aspects.ads (Aspect_No_Caching): New aspect. diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 599ac4c..30b6088 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -24169,7 +24169,7 @@ package body Sem_Prag is Error_Pragma_Arg ("argument of pragma% cannot be an incomplete type", Arg1); else - Set_Suppress_Initialization (Full_View (Base_Type (E))); + Set_Suppress_Initialization (Full_View (E)); end if; -- For first subtype, set flag on base type -- cgit v1.1 From 62f0fa2170c3875c28171caa4e1ce3a16a0dc18b Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 12 Aug 2019 09:00:04 +0000 Subject: [Ada] Improve error message for Object_Size clause on dynamic array This makes the compiler issue the same error: size clause not allowed for variable length type for an Object_Size clause on a variable-sized type as for a Size clause, for example on the following procedure: procedure P (X, Y : Integer) is subtype Sub is String (X .. Y) with Object_Size => 64; begin null; end; 2019-08-12 Eric Botcazou gcc/ada/ * freeze.adb (Freeze_Entity): Give the same error for an Object_Size clause on a variable-sized type as for a Size clause. From-SVN: r274294 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/freeze.adb | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4e76edf..d1e74ab 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-12 Eric Botcazou + + * freeze.adb (Freeze_Entity): Give the same error for an + Object_Size clause on a variable-sized type as for a Size + clause. + 2019-08-12 Gary Dismukes * sem_prag.adb (Analyze_Pragma, Pragma_Suppress_Initialization): diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 00d20e9..e4d52f6 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -6803,7 +6803,7 @@ package body Freeze is -- Do not allow a size clause for a type which does not have a size -- that is known at compile time - if Has_Size_Clause (E) + if (Has_Size_Clause (E) or else Has_Object_Size_Clause (E)) and then not Size_Known_At_Compile_Time (E) then -- Suppress this message if errors posted on E, even if we are -- cgit v1.1 From 5076fb182e2f99b46dca619f7be8e6e158bc902f Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Mon, 12 Aug 2019 09:00:27 +0000 Subject: [Ada] Implement Ada.Directories.Hierarchical_File_Names This patch corrects certain behaviors within Ada.Directories to better conform to conformance tests and implements the package Ada.Directories.Hierarchical_File_Names outlined in AI05-0049-1. Only partial test sources are included. ------------ -- Source -- ------------ -- main.ads with Ada.Directories.Hierarchical_File_Names; use Ada.Directories.Hierarchical_File_Names; with Ada.Exceptions; use Ada.Exceptions; with Ada.Text_IO; use Ada.Text_IO; procedure Main is FULL_PATH_A : constant String := "/export/work/user/bug"; FULL_PATH_B : constant String := "/export/work/user"; RELATIVE_PATH_A : constant String := "export/work/user/bug/"; RELATIVE_PATH_B : constant String := "export/work/user/bug"; SIMPLE_PATH_A : constant String := "bug/"; SIMPLE_PATH_B : constant String := "bug"; ROOT_PATH : constant String := "/"; CURRENT_DIR : constant String := "."; PARENT_DIR : constant String := ".."; RELATIVE_WITH_CURRENT : constant String := RELATIVE_PATH_A & "."; RELATIVE_WITH_PARENT : constant String := RELATIVE_PATH_A & ".."; begin Put_Line ("Simple_Name"); Put_Line (Is_Simple_Name (FULL_PATH_A)'Image); Put_Line (Is_Simple_Name (FULL_PATH_B)'Image); Put_Line (Is_Simple_Name (RELATIVE_PATH_A)'Image); Put_Line (Is_Simple_Name (RELATIVE_PATH_B)'Image); Put_Line (Is_Simple_Name (SIMPLE_PATH_A)'Image); Put_Line (Is_Simple_Name (SIMPLE_PATH_B)'Image); Put_Line (Is_Simple_Name (ROOT_PATH)'Image); Put_Line (Is_Simple_Name (CURRENT_DIR)'Image); Put_Line (Is_Simple_Name (PARENT_DIR)'Image); Put_Line (Is_Simple_Name (RELATIVE_WITH_CURRENT)'Image); Put_Line (Is_Simple_Name (RELATIVE_WITH_PARENT)'Image); Put_Line (Simple_Name (FULL_PATH_A)); Put_Line (Simple_Name (FULL_PATH_B)); Put_Line (Simple_Name (RELATIVE_PATH_A)); Put_Line (Simple_Name (RELATIVE_PATH_B)); Put_Line (Simple_Name (SIMPLE_PATH_A)); Put_Line (Simple_Name (SIMPLE_PATH_B)); Put_Line (Simple_Name (ROOT_PATH)); Put_Line (Simple_Name (CURRENT_DIR)); Put_Line (Simple_Name (PARENT_DIR)); Put_Line (Simple_Name (RELATIVE_WITH_CURRENT)); Put_Line (Simple_Name (RELATIVE_WITH_PARENT)); Put_Line ("Root_Directory_Name"); Put_Line (Is_Root_Directory_Name (FULL_PATH_A)'Image); Put_Line (Is_Root_Directory_Name (FULL_PATH_B)'Image); Put_Line (Is_Root_Directory_Name (RELATIVE_PATH_A)'Image); Put_Line (Is_Root_Directory_Name (RELATIVE_PATH_B)'Image); Put_Line (Is_Root_Directory_Name (SIMPLE_PATH_A)'Image); Put_Line (Is_Root_Directory_Name (SIMPLE_PATH_B)'Image); Put_Line (Is_Root_Directory_Name (ROOT_PATH)'Image); Put_Line (Is_Root_Directory_Name (CURRENT_DIR)'Image); Put_Line (Is_Root_Directory_Name (PARENT_DIR)'Image); Put_Line (Is_Root_Directory_Name (RELATIVE_WITH_CURRENT)'Image); Put_Line (Is_Root_Directory_Name (RELATIVE_WITH_PARENT)'Image); Put_Line ("Is_Parent_Directory_Name"); Put_Line (Is_Parent_Directory_Name (FULL_PATH_A)'Image); Put_Line (Is_Parent_Directory_Name (FULL_PATH_B)'Image); Put_Line (Is_Parent_Directory_Name (RELATIVE_PATH_A)'Image); Put_Line (Is_Parent_Directory_Name (RELATIVE_PATH_B)'Image); Put_Line (Is_Parent_Directory_Name (SIMPLE_PATH_A)'Image); Put_Line (Is_Parent_Directory_Name (SIMPLE_PATH_B)'Image); Put_Line (Is_Parent_Directory_Name (ROOT_PATH)'Image); Put_Line (Is_Parent_Directory_Name (CURRENT_DIR)'Image); Put_Line (Is_Parent_Directory_Name (PARENT_DIR)'Image); Put_Line (Is_Parent_Directory_Name (RELATIVE_WITH_CURRENT)'Image); Put_Line (Is_Parent_Directory_Name (RELATIVE_WITH_PARENT)'Image); Put_Line ("Is_Current_Directory_Name"); Put_Line (Is_Current_Directory_Name (FULL_PATH_A)'Image); Put_Line (Is_Current_Directory_Name (FULL_PATH_B)'Image); Put_Line (Is_Current_Directory_Name (RELATIVE_PATH_A)'Image); Put_Line (Is_Current_Directory_Name (RELATIVE_PATH_B)'Image); Put_Line (Is_Current_Directory_Name (SIMPLE_PATH_A)'Image); Put_Line (Is_Current_Directory_Name (SIMPLE_PATH_B)'Image); Put_Line (Is_Current_Directory_Name (ROOT_PATH)'Image); Put_Line (Is_Current_Directory_Name (CURRENT_DIR)'Image); Put_Line (Is_Current_Directory_Name (PARENT_DIR)'Image); Put_Line (Is_Current_Directory_Name (RELATIVE_WITH_CURRENT)'Image); Put_Line (Is_Current_Directory_Name (RELATIVE_WITH_PARENT)'Image); Put_Line ("Is_Full_Name"); Put_Line (Is_Full_Name (FULL_PATH_A)'Image); Put_Line (Is_Full_Name (FULL_PATH_B)'Image); Put_Line (Is_Full_Name (RELATIVE_PATH_A)'Image); Put_Line (Is_Full_Name (RELATIVE_PATH_B)'Image); Put_Line (Is_Full_Name (SIMPLE_PATH_A)'Image); Put_Line (Is_Full_Name (SIMPLE_PATH_B)'Image); Put_Line (Is_Full_Name (ROOT_PATH)'Image); Put_Line (Is_Full_Name (CURRENT_DIR)'Image); Put_Line (Is_Full_Name (PARENT_DIR)'Image); Put_Line (Is_Full_Name (RELATIVE_WITH_CURRENT)'Image); Put_Line (Is_Full_Name (RELATIVE_WITH_PARENT)'Image); Put_Line ("Relative_Name"); Put_Line (Is_Relative_Name (FULL_PATH_A)'Image); Put_Line (Is_Relative_Name (FULL_PATH_B)'Image); Put_Line (Is_Relative_Name (RELATIVE_PATH_A)'Image); Put_Line (Is_Relative_Name (RELATIVE_PATH_B)'Image); Put_Line (Is_Relative_Name (SIMPLE_PATH_A)'Image); Put_Line (Is_Relative_Name (SIMPLE_PATH_B)'Image); Put_Line (Is_Relative_Name (ROOT_PATH)'Image); Put_Line (Is_Relative_Name (CURRENT_DIR)'Image); Put_Line (Is_Relative_Name (PARENT_DIR)'Image); Put_Line (Is_Relative_Name (RELATIVE_WITH_CURRENT)'Image); Put_Line (Is_Relative_Name (RELATIVE_WITH_PARENT)'Image); Put_Line (Relative_Name (FULL_PATH_A)); Put_Line (Relative_Name (FULL_PATH_B)); Put_Line (Relative_Name (RELATIVE_PATH_A)); Put_Line (Relative_Name (RELATIVE_PATH_B)); begin Put_Line (Relative_Name (SIMPLE_PATH_A)); exception when E: others => Put_Line (Exception_Information (E)); end; begin Put_Line (Relative_Name (SIMPLE_PATH_B)); exception when E: others => Put_Line (Exception_Information (E)); end; begin Put_Line (Relative_Name (ROOT_PATH)); exception when E: others => Put_Line (Exception_Information (E)); end; begin Put_Line (Relative_Name (CURRENT_DIR)); exception when E: others => Put_Line (Exception_Information (E)); end; begin Put_Line (Relative_Name (PARENT_DIR)); exception when E: others => Put_Line (Exception_Information (E)); end; Put_Line (Relative_Name (RELATIVE_WITH_CURRENT)); Put_Line (Relative_Name (RELATIVE_WITH_PARENT)); Put_Line ("Containing_Directory"); Put_Line (Containing_Directory (FULL_PATH_A)); Put_Line (Containing_Directory (FULL_PATH_B)); Put_Line (Containing_Directory (RELATIVE_PATH_A)); Put_Line (Containing_Directory (RELATIVE_PATH_B)); Put_Line (Containing_Directory (SIMPLE_PATH_A)); Put_Line (Containing_Directory (SIMPLE_PATH_B)); begin Put_Line (Containing_Directory (ROOT_PATH)); exception when E: others => Put_Line (Exception_Information (E)); end; begin Put_Line (Containing_Directory (CURRENT_DIR)); exception when E: others => Put_Line (Exception_Information (E)); end; begin Put_Line (Containing_Directory (PARENT_DIR)); exception when E: others => Put_Line (Exception_Information (E)); end; Put_Line (Containing_Directory (RELATIVE_WITH_CURRENT)); Put_Line (Containing_Directory (RELATIVE_WITH_PARENT)); Put_Line ("Initial_Directory"); Put_Line (Initial_Directory (FULL_PATH_A)); Put_Line (Initial_Directory (FULL_PATH_B)); Put_Line (Initial_Directory (RELATIVE_PATH_A)); Put_Line (Initial_Directory (RELATIVE_PATH_B)); Put_Line (Initial_Directory (SIMPLE_PATH_A)); Put_Line (Initial_Directory (SIMPLE_PATH_B)); Put_Line (Initial_Directory (ROOT_PATH)); Put_Line (Initial_Directory (CURRENT_DIR)); Put_Line (Initial_Directory (PARENT_DIR)); Put_Line (Initial_Directory (RELATIVE_WITH_CURRENT)); Put_Line (Initial_Directory (RELATIVE_WITH_PARENT)); end; ----------------- -- Compilation -- ----------------- $ gnatmake -q main.adb Simple_Name FALSE FALSE FALSE FALSE TRUE TRUE FALSE TRUE TRUE FALSE FALSE bug user bug bug bug bug / . .. . .. Root_Directory_Name FALSE FALSE FALSE FALSE FALSE FALSE TRUE FALSE FALSE FALSE FALSE Is_Parent_Directory_Name FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE FALSE FALSE Is_Current_Directory_Name FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE FALSE FALSE FALSE Is_Full_Name TRUE TRUE FALSE FALSE FALSE FALSE TRUE FALSE FALSE FALSE FALSE Relative_Name FALSE FALSE TRUE TRUE TRUE TRUE FALSE TRUE TRUE TRUE TRUE export/work/user/bug export/work/user work/user/bug/ work/user/bug raised ADA.IO_EXCEPTIONS.NAME_ERROR : relative path name "bug/" is composed of a single part raised ADA.IO_EXCEPTIONS.NAME_ERROR : relative path name "bug" is composed of a single part raised ADA.IO_EXCEPTIONS.NAME_ERROR : relative path name "/" is composed of a single part raised ADA.IO_EXCEPTIONS.NAME_ERROR : relative path name "." is composed of a single part raised ADA.IO_EXCEPTIONS.NAME_ERROR : relative path name ".." is composed of a single part work/user/bug/. work/user/bug/.. Containing_Directory /export/work/user /export/work export/work/user/bug export/work/user bug . raised ADA.IO_EXCEPTIONS.USE_ERROR : directory "/" has no containing directory raised ADA.IO_EXCEPTIONS.USE_ERROR : directory "." has no containing directory raised ADA.IO_EXCEPTIONS.USE_ERROR : directory ".." has no containing directory export/work/user/bug export/work/user/bug Initial_Directory / / export export bug bug / . .. export export 2019-08-12 Justin Squirek gcc/ada/ * libgnat/a-dhfina.adb, libgnat/a-dhfina.ads (Is_Simple_Name, Is_Root_Directory, Is_Parent_Directory, Is_Current_Directory_Name, Is_Relative_Name, Initial_Directory, Relative_Name, Compose): Add implementation and documentation. * libgnat/a-direct.adb (Containing_Directory): Modify routine to use routines from Ada.Directories.Hierarchical_File_Names and remove incorrect special case for parent directories. (Fetch_Next_Entry): Add check for current directory and parent directory and ignore them under certain circumstances. (Simple_Nmae): Add check for null result from Simple_Name_Internal and raise Name_Error. (Simple_Name_Internal): Add explicit check for root directories, sanitize trailing directory separators, and modify behavior so that current and parent directories are considered valid results. * Makefile.rtl: Add entry to GNATRTL_NONTASKING_OBJS. From-SVN: r274295 --- gcc/ada/ChangeLog | 19 +++ gcc/ada/Makefile.rtl | 1 + gcc/ada/libgnat/a-dhfina.adb | 332 +++++++++++++++++++++++++++++++++++++++++++ gcc/ada/libgnat/a-dhfina.ads | 70 ++++++++- gcc/ada/libgnat/a-direct.adb | 94 ++++++------ 5 files changed, 466 insertions(+), 50 deletions(-) create mode 100644 gcc/ada/libgnat/a-dhfina.adb (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d1e74ab..244e917 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2019-08-12 Justin Squirek + + * libgnat/a-dhfina.adb, libgnat/a-dhfina.ads (Is_Simple_Name, + Is_Root_Directory, Is_Parent_Directory, + Is_Current_Directory_Name, Is_Relative_Name, Initial_Directory, + Relative_Name, Compose): Add implementation and documentation. + * libgnat/a-direct.adb (Containing_Directory): Modify routine to + use routines from Ada.Directories.Hierarchical_File_Names and + remove incorrect special case for parent directories. + (Fetch_Next_Entry): Add check for current directory and parent + directory and ignore them under certain circumstances. + (Simple_Nmae): Add check for null result from + Simple_Name_Internal and raise Name_Error. + (Simple_Name_Internal): Add explicit check for root directories, + sanitize trailing directory separators, and modify behavior so + that current and parent directories are considered valid + results. + * Makefile.rtl: Add entry to GNATRTL_NONTASKING_OBJS. + 2019-08-12 Eric Botcazou * freeze.adb (Freeze_Entity): Give the same error for an diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 6528df8..d6dd151 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -171,6 +171,7 @@ GNATRTL_NONTASKING_OBJS= \ a-cwila1$(objext) \ a-cwila9$(objext) \ a-decima$(objext) \ + a-dhfina$(objext) \ a-diocst$(objext) \ a-direct$(objext) \ a-direio$(objext) \ diff --git a/gcc/ada/libgnat/a-dhfina.adb b/gcc/ada/libgnat/a-dhfina.adb new file mode 100644 index 0000000..df7c345 --- /dev/null +++ b/gcc/ada/libgnat/a-dhfina.adb @@ -0,0 +1,332 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- ADA.DIRECTORIES.HIERARCHICAL_FILE_NAMES -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2004-2019, 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 3, 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. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- In particular, you can freely distribute your programs built with the -- +-- GNAT Pro compiler, including any required library run-time units, using -- +-- any licensing terms of your choosing. See the AdaCore Software License -- +-- for full details. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +with Ada.Characters.Handling; use Ada.Characters.Handling; +with Ada.Directories.Validity; use Ada.Directories.Validity; +with Ada.Strings.Fixed; use Ada.Strings.Fixed; +with System; use System; + +package body Ada.Directories.Hierarchical_File_Names is + + Dir_Separator : constant Character; + pragma Import (C, Dir_Separator, "__gnat_dir_separator"); + -- Running system default directory separator + + ----------------- + -- Subprograms -- + ----------------- + + function Equivalent_File_Names + (Left : String; + Right : String) + return Boolean; + -- Perform an OS-independent comparison between two file paths + + function Is_Absolute_Path (Name : String) return Boolean; + -- Returns True if Name is an absolute path name, i.e. it designates a + -- file or directory absolutely rather than relative to another directory. + + --------------------------- + -- Equivalent_File_Names -- + --------------------------- + + function Equivalent_File_Names + (Left : String; + Right : String) + return Boolean + is + begin + -- Check the validity of the input paths + + if not Is_Valid_Path_Name (Left) + or else not Is_Valid_Path_Name (Right) + then + return False; + end if; + + -- Normalize the paths by removing any trailing directory separators and + -- perform the comparison. + + declare + Normal_Left : constant String := + (if Index (Left, Dir_Separator & "", Strings.Backward) = Left'Last + and then not Is_Root_Directory_Name (Left) + then + Left (Left'First .. Left'Last - 1) + else + Left); + + Normal_Right : constant String := + (if Index (Right, Dir_Separator & "", Strings.Backward) = Right'Last + and then not Is_Root_Directory_Name (Right) + then + Right (Right'First .. Right'Last - 1) + else + Right); + begin + -- Within Windows we assume case insensitivity + + if not Windows then + return Normal_Left = Normal_Right; + end if; + + -- Otherwise do a straight comparison + + return To_Lower (Normal_Left) = To_Lower (Normal_Right); + end; + end Equivalent_File_Names; + + ---------------------- + -- Is_Absolute_Path -- + ---------------------- + + function Is_Absolute_Path (Name : String) return Boolean is + function Is_Absolute_Path + (Name : Address; + Length : Integer) return Integer; + pragma Import (C, Is_Absolute_Path, "__gnat_is_absolute_path"); + begin + return Is_Absolute_Path (Name'Address, Name'Length) /= 0; + end Is_Absolute_Path; + + -------------------- + -- Is_Simple_Name -- + -------------------- + + function Is_Simple_Name (Name : String) return Boolean is + begin + -- Verify the file path name is valid and that it is not a root + + if not Is_Valid_Path_Name (Name) + or else Is_Root_Directory_Name (Name) + then + return False; + end if; + + -- Check for the special paths "." and "..", which are considered simple + + if Is_Parent_Directory_Name (Name) + or else Is_Current_Directory_Name (Name) + then + return True; + end if; + + -- Perform a comparison with the calculated simple path name + + return Equivalent_File_Names (Simple_Name (Name), Name); + end Is_Simple_Name; + + ---------------------------- + -- Is_Root_Directory_Name -- + ---------------------------- + + function Is_Root_Directory_Name (Name : String) return Boolean is + begin + -- Check if the path name is a root directory by looking for a slash in + -- the general case, and a drive letter in the case of Windows. + + return Name = "/" + or else + (Windows + and then + (Name = "\" + or else + (Name'Length = 3 + and then Name (Name'Last - 1) = ':' + and then Name (Name'Last) in '/' | '\' + and then (Name (Name'First) in 'a' .. 'z' + or else + Name (Name'First) in 'A' .. 'Z')) + or else + (Name'Length = 2 + and then Name (Name'Last) = ':' + and then (Name (Name'First) in 'a' .. 'z' + or else + Name (Name'First) in 'A' .. 'Z')))); + end Is_Root_Directory_Name; + + ------------------------------ + -- Is_Parent_Directory_Name -- + ------------------------------ + + function Is_Parent_Directory_Name (Name : String) return Boolean is + begin + return Name = ".."; + end Is_Parent_Directory_Name; + + ------------------------------- + -- Is_Current_Directory_Name -- + ------------------------------- + + function Is_Current_Directory_Name (Name : String) return Boolean is + begin + return Name = "."; + end Is_Current_Directory_Name; + + ------------------ + -- Is_Full_Name -- + ------------------ + + function Is_Full_Name (Name : String) return Boolean is + begin + return Equivalent_File_Names (Full_Name (Name), Name); + end Is_Full_Name; + + ---------------------- + -- Is_Relative_Name -- + ---------------------- + + function Is_Relative_Name (Name : String) return Boolean is + begin + return not Is_Absolute_Path (Name) + and then Is_Valid_Path_Name (Name); + end Is_Relative_Name; + + ----------------------- + -- Initial_Directory -- + ----------------------- + + function Initial_Directory (Name : String) return String is + Start : constant Integer := Index (Name, Dir_Separator & ""); + begin + -- Verify path name + + if not Is_Valid_Path_Name (Name) then + raise Name_Error with "invalid path name """ & Name & '"'; + end if; + + -- When there is no starting directory separator or the path name is a + -- root directory then the path name is already simple - so return it. + + if Is_Root_Directory_Name (Name) or else Start = 0 then + return Name; + end if; + + -- When the initial directory of the path name is a root directory then + -- the starting directory separator is part of the result so we must + -- return it in the slice. + + if Is_Root_Directory_Name (Name (Name'First .. Start)) then + return Name (Name'First .. Start); + end if; + + -- Otherwise we grab a slice up to the starting directory separator + + return Name (Name'First .. Start - 1); + end Initial_Directory; + + ------------------- + -- Relative_Name -- + ------------------- + + function Relative_Name (Name : String) return String is + begin + -- We cannot derive a relative name if Name does not exist + + if not Is_Relative_Name (Name) + and then not Is_Valid_Path_Name (Name) + then + raise Name_Error with "invalid relative path name """ & Name & '"'; + end if; + + -- Name only has a single part and thus cannot be made relative + + if Is_Simple_Name (Name) + or else Is_Root_Directory_Name (Name) + then + raise Name_Error with + "relative path name """ & Name & """ is composed of a single part"; + end if; + + -- Trim the input according to the initial directory and maintain proper + -- directory separation due to the fact that root directories may + -- contain separators. + + declare + Init_Dir : constant String := Initial_Directory (Name); + begin + if Init_Dir (Init_Dir'Last) = Dir_Separator then + return Name (Name'First + Init_Dir'Length .. Name'Last); + end if; + + return Name (Name'First + Init_Dir'Length + 1 .. Name'Last); + end; + end Relative_Name; + + ------------- + -- Compose -- + ------------- + + function Compose + (Directory : String := ""; + Relative_Name : String; + Extension : String := "") return String + is + -- Append a directory separator if none is present + + Separated_Dir : constant String := + (if Directory = "" then "" + elsif Directory (Directory'Last) = Dir_Separator then Directory + else Directory & Dir_Separator); + begin + -- Check that relative name is valid + + if not Is_Relative_Name (Relative_Name) then + raise Name_Error with + "invalid relative path name """ & Relative_Name & '"'; + end if; + + -- Check that directory is valid + + if Separated_Dir /= "" + and then (not Is_Valid_Path_Name (Separated_Dir & Relative_Name)) + then + raise Name_Error with + "invalid path composition """ & Separated_Dir & Relative_Name & '"'; + end if; + + -- Check that the extension is valid + + if Extension /= "" + and then not Is_Valid_Path_Name + (Separated_Dir & Relative_Name & Extension) + then + raise Name_Error with + "invalid path composition """ + & Separated_Dir & Relative_Name & Extension & '"'; + end if; + + -- Concatenate the result + + return Separated_Dir & Relative_Name & Extension; + end Compose; + +end Ada.Directories.Hierarchical_File_Names; diff --git a/gcc/ada/libgnat/a-dhfina.ads b/gcc/ada/libgnat/a-dhfina.ads index e34c664..fe32d01 100644 --- a/gcc/ada/libgnat/a-dhfina.ads +++ b/gcc/ada/libgnat/a-dhfina.ads @@ -6,41 +6,101 @@ -- -- -- S p e c -- -- -- --- This specification is derived from the Ada Reference Manual for use with -- --- GNAT. In accordance with the copyright of that document, you can freely -- --- copy and modify this specification, provided that if you redistribute a -- --- modified version, any changes that you have made are clearly indicated. -- +-- Copyright (C) 2004-2019, 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 3, 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. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- In particular, you can freely distribute your programs built with the -- +-- GNAT Pro compiler, including any required library run-time units, using -- +-- any licensing terms of your choosing. See the AdaCore Software License -- +-- for full details. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ package Ada.Directories.Hierarchical_File_Names is - pragma Unimplemented_Unit; function Is_Simple_Name (Name : String) return Boolean; + -- Returns True if Name is a simple name, and returns False otherwise. function Is_Root_Directory_Name (Name : String) return Boolean; + -- Returns True if Name is syntactically a root (a directory that cannot + -- be decomposed further), and returns False otherwise. function Is_Parent_Directory_Name (Name : String) return Boolean; + -- Returns True if Name can be used to indicate symbolically the parent + -- directory of any directory, and returns False otherwise. function Is_Current_Directory_Name (Name : String) return Boolean; + -- Returns True if Name can be used to indicate symbolically the directory + -- itself for any directory, and returns False otherwise. function Is_Full_Name (Name : String) return Boolean; + -- Returns True if the leftmost directory part of Name is a root, and + -- returns False otherwise. function Is_Relative_Name (Name : String) return Boolean; + -- Returns True if Name allows the identification of an external file + -- (including directories and special files) but is not a full name, and + -- returns False otherwise. function Simple_Name (Name : String) return String renames Ada.Directories.Simple_Name; + -- Returns the simple name portion of the file name specified by Name. The + -- exception Name_Error is propagated if the string given as Name does not + -- allow the identification of an external file (including directories and + -- special files). function Containing_Directory (Name : String) return String renames Ada.Directories.Containing_Directory; + -- Returns the name of the containing directory of the external file + -- (including directories) identified by Name. If more than one directory + -- can contain Name, the directory name returned is implementation-defined. + -- The exception Name_Error is propagated if the string given as Name does + -- not allow the identification of an external file. The exception + -- Use_Error is propagated if the external file does not have a containing + -- directory. function Initial_Directory (Name : String) return String; + -- Returns the leftmost directory part in Name. That is, it returns a root + -- directory name (for a full name), or one of a parent directory name, a + -- current directory name, or a simple name (for a relative name). The + -- exception Name_Error is propagated if the string given as Name does not + -- allow the identification of an external file (including directories and + -- special files). function Relative_Name (Name : String) return String; + -- Returns the entire file name except the Initial_Directory portion. The + -- exception Name_Error is propagated if the string given as Name does not + -- allow the identification of an external file (including directories and + -- special files), or if Name has a single part (this includes if any of + -- Is_Simple_Name, Is_Root_Directory_Name, Is_Parent_Directory_Name, or + -- Is_Current_Directory_Name are True). function Compose (Directory : String := ""; Relative_Name : String; Extension : String := "") return String; + -- Returns the name of the external file with the specified Directory, + -- Relative_Name, and Extension. The exception Name_Error is propagated if + -- the string given as Directory is not the null string and does not allow + -- the identification of a directory, or if Is_Relative_Name + -- (Relative_Name) is False, or if the string given as Extension is not + -- the null string and is not a possible extension, or if Extension is not + -- the null string and Simple_Name (Relative_Name) is not a base name. + -- + -- The result of Compose is a full name if Is_Full_Name (Directory) is + -- True; result is a relative name otherwise. end Ada.Directories.Hierarchical_File_Names; diff --git a/gcc/ada/libgnat/a-direct.adb b/gcc/ada/libgnat/a-direct.adb index bc489ca..1a1b708 100644 --- a/gcc/ada/libgnat/a-direct.adb +++ b/gcc/ada/libgnat/a-direct.adb @@ -33,6 +33,8 @@ with Ada.Calendar; use Ada.Calendar; with Ada.Calendar.Formatting; use Ada.Calendar.Formatting; with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Directories.Validity; use Ada.Directories.Validity; +with Ada.Directories.Hierarchical_File_Names; +use Ada.Directories.Hierarchical_File_Names; with Ada.Strings.Fixed; with Ada.Strings.Maps; use Ada.Strings.Maps; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; @@ -224,31 +226,22 @@ package body Ada.Directories is Strings.Fixed.Index (Name, Dir_Seps, Going => Strings.Backward); begin - if Last_DS = 0 then - - -- There is no directory separator, returns "." representing - -- the current working directory. - - return "."; - -- If Name indicates a root directory, raise Use_Error, because -- it has no containing directory. - elsif Name = "/" - or else - (Windows - and then - (Name = "\" - or else - (Name'Length = 3 - and then Name (Name'Last - 1 .. Name'Last) = ":\" - and then (Name (Name'First) in 'a' .. 'z' - or else - Name (Name'First) in 'A' .. 'Z')))) + if Is_Parent_Directory_Name (Name) + or else Is_Current_Directory_Name (Name) + or else Is_Root_Directory_Name (Name) then raise Use_Error with "directory """ & Name & """ has no containing directory"; + elsif Last_DS = 0 then + -- There is no directory separator, so return ".", representing + -- the current working directory. + + return "."; + else declare Last : Positive := Last_DS - Name'First + 1; @@ -262,31 +255,14 @@ package body Ada.Directories is -- number on Windows. while Last > 1 loop - exit when - Result (Last) /= '/' - and then - Result (Last) /= Directory_Separator; - - exit when Windows - and then Last = 3 - and then Result (2) = ':' - and then - (Result (1) in 'A' .. 'Z' - or else - Result (1) in 'a' .. 'z'); + exit when Is_Root_Directory_Name (Result (1 .. Last)) + or else (Result (Last) /= Directory_Separator + and then Result (Last) /= '/'); Last := Last - 1; end loop; - -- Special case of "..": the current directory may be a root - -- directory. - - if Last = 2 and then Result (1 .. 2) = ".." then - return Containing_Directory (Current_Directory); - - else - return Result (1 .. Last); - end if; + return Result (1 .. Last); end; end if; end; @@ -806,6 +782,20 @@ package body Ada.Directories is end if; if Exists = 1 then + -- Ignore special directories "." and ".." + + if (Full_Name'Length > 1 + and then + Full_Name + (Full_Name'Last - 1 .. Full_Name'Last) = "\.") + or else + (Full_Name'Length > 2 + and then + Full_Name + (Full_Name'Last - 2 .. Full_Name'Last) = "\..") + then + Exists := 0; + end if; -- Now check if the file kind matches the filter @@ -1280,16 +1270,30 @@ package body Ada.Directories is function Simple_Name_Internal (Path : String) return String is Cut_Start : Natural := Strings.Fixed.Index (Path, Dir_Seps, Going => Strings.Backward); - Cut_End : Natural; + + -- Cut_End points to the last simple name character + + Cut_End : Natural := Path'Last; begin - -- Cut_Start pointS to the first simple name character + -- Root directories are considered simple - Cut_Start := (if Cut_Start = 0 then Path'First else Cut_Start + 1); + if Is_Root_Directory_Name (Path) then + return Path; + end if; + + -- Handle trailing directory separators + + if Cut_Start = Path'Last then + Cut_End := Path'Last - 1; + Cut_Start := Strings.Fixed.Index + (Path (Path'First .. Path'Last - 1), + Dir_Seps, Going => Strings.Backward); + end if; - -- Cut_End point to the last simple name character + -- Cut_Start points to the first simple name character - Cut_End := Path'Last; + Cut_Start := (if Cut_Start = 0 then Path'First else Cut_Start + 1); Check_For_Standard_Dirs : declare BN : constant String := Path (Cut_Start .. Cut_End); @@ -1301,7 +1305,7 @@ package body Ada.Directories is begin if BN = "." or else BN = ".." then - return ""; + return BN; elsif Has_Drive_Letter and then BN'Length > 2 -- cgit v1.1 From 2d56744e3bfcf3cc27f4100b1903b2443d858f13 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Mon, 12 Aug 2019 09:00:39 +0000 Subject: [Ada] Minor cleanups in exception handling No change in behavior, so no test. 2019-08-12 Bob Duff gcc/ada/ * libgnat/a-except.ads: Update obsolete comment, still making clear that this is a variant. Add explicit default for Id component of Exception_Occurrence, because that value is used. Define Null_Occurrence less redundantly. * libgnat/a-einuoc.adb: Minor simplification of code. From-SVN: r274296 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/libgnat/a-einuoc.adb | 6 +----- gcc/ada/libgnat/a-except.ads | 22 ++++------------------ 3 files changed, 13 insertions(+), 23 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 244e917..351cc49 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-08-12 Bob Duff + + * libgnat/a-except.ads: Update obsolete comment, still making + clear that this is a variant. Add explicit default for Id + component of Exception_Occurrence, because that value is used. + Define Null_Occurrence less redundantly. + * libgnat/a-einuoc.adb: Minor simplification of code. + 2019-08-12 Justin Squirek * libgnat/a-dhfina.adb, libgnat/a-dhfina.ads (Is_Simple_Name, diff --git a/gcc/ada/libgnat/a-einuoc.adb b/gcc/ada/libgnat/a-einuoc.adb index a949a16..77d6b8d 100644 --- a/gcc/ada/libgnat/a-einuoc.adb +++ b/gcc/ada/libgnat/a-einuoc.adb @@ -40,9 +40,5 @@ begin -- The null exception is uniquely identified by the fact that the Id value -- is null. No other exception occurrence can have a null Id. - if X.Id = Null_Id then - return True; - else - return False; - end if; + return X.Id = Null_Id; end Ada.Exceptions.Is_Null_Occurrence; diff --git a/gcc/ada/libgnat/a-except.ads b/gcc/ada/libgnat/a-except.ads index 60ff5db..4f70769 100644 --- a/gcc/ada/libgnat/a-except.ads +++ b/gcc/ada/libgnat/a-except.ads @@ -33,14 +33,8 @@ -- -- ------------------------------------------------------------------------------ --- This version of Ada.Exceptions fully supports Ada 95 and later language --- versions. It is used in all situations except for the build of the --- compiler and other basic tools. For these latter builds, we use an --- Ada 95-only version. - --- The reason for this splitting off of a separate version is to support --- older bootstrap compilers that do not support Ada 2005 features, and --- Ada.Exceptions is part of the compiler sources. +-- This is the default version of this package. We also have cert and zfp +-- versions. pragma Polling (Off); -- We must turn polling off for this unit, because otherwise we get @@ -284,7 +278,7 @@ private -- Traceback array stored in exception occurrence type Exception_Occurrence is record - Id : Exception_Id; + Id : Exception_Id := Null_Id; -- Exception_Identity for this exception occurrence Machine_Occurrence : System.Address; @@ -336,14 +330,6 @@ private pragma Stream_Convert (Exception_Occurrence, String_To_EO, EO_To_String); -- Functions for implementing Exception_Occurrence stream attributes - Null_Occurrence : constant Exception_Occurrence := ( - Id => null, - Machine_Occurrence => System.Null_Address, - Msg_Length => 0, - Msg => (others => ' '), - Exception_Raised => False, - Pid => 0, - Num_Tracebacks => 0, - Tracebacks => (others => TBE.Null_TB_Entry)); + Null_Occurrence : constant Exception_Occurrence := (others => <>); end Ada.Exceptions; -- cgit v1.1 From 6ab24ed7528b0375c49e4416f825a90bdca63454 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 12 Aug 2019 09:00:59 +0000 Subject: [Ada] Improper error message on equality op with different operand types 2019-08-12 Ed Schonberg gcc/ada/ * sem_ch6.adb (heck_Untagged_Equality): Verify that user-defined equality has the same profile as the predefined equality before applying legality rule in RM 4.5.2 (9.8). gcc/testsuite/ * gnat.dg/equal10.adb, gnat.dg/equal10.ads: New testcase. From-SVN: r274297 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/sem_ch6.adb | 3 ++- 2 files changed, 8 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 351cc49..3c22a90 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-12 Ed Schonberg + + * sem_ch6.adb (heck_Untagged_Equality): Verify that user-defined + equality has the same profile as the predefined equality before + applying legality rule in RM 4.5.2 (9.8). + 2019-08-12 Bob Duff * libgnat/a-except.ads: Update obsolete comment, still making diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 25ee705..3c026bf 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -8420,11 +8420,12 @@ package body Sem_Ch6 is begin -- This check applies only if we have a subprogram declaration with an - -- untagged record type. + -- untagged record type that is conformant to the predefined op. if Nkind (Decl) /= N_Subprogram_Declaration or else not Is_Record_Type (Typ) or else Is_Tagged_Type (Typ) + or else Etype (Next_Formal (First_Formal (Eq_Op))) /= Typ then return; end if; -- cgit v1.1 From ecb2f4fe0078a1439b80356459ce0c97edfbc30a Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Mon, 12 Aug 2019 09:01:04 +0000 Subject: [Ada] Hang on loop in generic with subtype indication specifying a range The compiler may hang when a for loop expanded in a generic instantiation has a range specified by a subtype indication with an explicit range that has a bound that is an attribute applied to a discriminant-dependent array component. The Parent field of the bound may not be set, which can lead to endless looping when an actual subtype created for the array component is passed to Insert_Actions. This is fixed by setting the Parent fields of the copied bounds before Preanalyze is called on them. 2019-08-12 Gary Dismukes gcc/ada/ * sem_ch5.adb (Prepare_Param_Spec_Loop): Set the parents of the copied low and high bounds in the case where the loop range is given by a discrete_subtype_indication, to prevent hanging (or Assert_Failure) in Insert_Actions. gcc/testsuite/ * gnat.dg/generic_inst7.adb, gnat.dg/generic_inst7_pkg.adb, gnat.dg/generic_inst7_pkg.ads, gnat.dg/generic_inst7_types.ads: New testcase. From-SVN: r274298 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/sem_ch5.adb | 7 ++++++- 2 files changed, 13 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3c22a90..1482a50 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-08-12 Gary Dismukes + + * sem_ch5.adb (Prepare_Param_Spec_Loop): Set the parents of the + copied low and high bounds in the case where the loop range is + given by a discrete_subtype_indication, to prevent hanging (or + Assert_Failure) in Insert_Actions. + 2019-08-12 Ed Schonberg * sem_ch6.adb (heck_Untagged_Equality): Verify that user-defined diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index ebe610b..963819e 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -3636,11 +3636,16 @@ package body Sem_Ch5 is then Rng := Range_Expression (Constraint (Rng)); - -- Preanalyze the bounds of the range constraint + -- Preanalyze the bounds of the range constraint, setting + -- parent fields to associate the copied bounds with the range, + -- allowing proper tree climbing during preanalysis. Low := New_Copy_Tree (Low_Bound (Rng)); High := New_Copy_Tree (High_Bound (Rng)); + Set_Parent (Low, Rng); + Set_Parent (High, Rng); + Preanalyze (Low); Preanalyze (High); -- cgit v1.1 From 0e5f9f5020f798333b7ca2fd10cd48d8cfc09e6c Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Mon, 12 Aug 2019 09:01:09 +0000 Subject: [Ada] Remove doc for language version switches Remove documentation for Ada language version switches, and note that they are no longer needed. These tools now silently ignore such switches, and process the file correctly no matter what version of Ada is used. 2019-08-12 Bob Duff gcc/ada/ * doc/gnat_ugn/gnat_utility_programs.rst (gnatmetric, gnatpp, gnatstub): Remove documentation for Ada language version switches, and note that they are no longer needed. From-SVN: r274299 --- gcc/ada/ChangeLog | 6 ++ gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst | 95 +++++++++----------------- 2 files changed, 39 insertions(+), 62 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1482a50..1bf7e6d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-12 Bob Duff + + * doc/gnat_ugn/gnat_utility_programs.rst (gnatmetric, gnatpp, + gnatstub): Remove documentation for Ada language version + switches, and note that they are no longer needed. + 2019-08-12 Gary Dismukes * sem_ch5.adb (Prepare_Param_Spec_Loop): Set the parents of the diff --git a/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst b/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst index fc39214..db0a82e 100644 --- a/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst +++ b/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst @@ -1797,9 +1797,6 @@ Alternatively, you may run the script using the following command line: .. index:: ! gnatmetric .. index:: Metric tool - This documentation is for the new libadalang-based version - of ``gnatmetric``, which replaces the ASIS-based version. - The ``gnatmetric`` tool is a utility for computing various program metrics. It takes an Ada source file as input and generates a file containing the @@ -1822,14 +1819,16 @@ Alternatively, you may run the script using the following command line: * ``switches`` specify the metrics to compute and define the destination for the output - * Each ``filename`` is the name (including the extension) of a source - file to process. 'Wildcards' are allowed, and - the file name may contain path information. - If no ``filename`` is supplied, then the ``switches`` list must contain - at least one - :switch:`--files` switch (see :ref:`Other_gnatmetric_Switches`). - Including both a :switch:`--files` switch and one or more - ``filename`` arguments is permitted. + * Each ``filename`` is the name of a source file to process. 'Wildcards' are + allowed, and the file name may contain path information. If no + ``filename`` is supplied, then the ``switches`` list must contain at least + one :switch:`--files` switch (see :ref:`Other_gnatmetric_Switches`). + Including both a :switch:`--files` switch and one or more ``filename`` + arguments is permitted. + + Note that it is no longer necessary to specify the Ada language version; + ``gnatmetric`` can process Ada source code written in any version from + Ada 83 onward without specifying any language version switch. The following subsections describe the various switches accepted by ``gnatmetric``, organized by category. @@ -1928,6 +1927,16 @@ Alternatively, you may run the script using the following command line: to exclude all directory information from the file names that are output.) + .. index:: --wide-character-encoding (gnatmetric) + + :switch:`--wide-character-encoding={e}` + Specify the wide character encoding method for the input and output + files. ``e`` is one of the following: + + * *8* - UTF-8 encoding + + * *b* - Brackets encoding (default value) + .. index:: Disable Metrics For Local Units in gnatmetric @@ -2811,6 +2820,11 @@ Alternatively, you may run the script using the following command line: :switch:`-sfn` :switch:`--short-file-names` + .. index:: -W (gnatsmetric) + + :switch:`-W{e}` + :switch:`--wide-character-encoding={e}` + .. index:: -nolocal (gnatmetric) :switch:`-nolocal` @@ -2846,9 +2860,6 @@ Alternatively, you may run the script using the following command line: .. index:: ! gnatpp .. index:: pretty printer - This documentation is for the new libadalang-based version - of ``gnatpp``, which replaces the ASIS-based version. - The ``gnatpp`` tool is a utility for source reformatting / pretty printing. It takes an Ada source file as input and generates a reformatted version as output. You can specify various style @@ -2880,6 +2891,10 @@ Alternatively, you may run the script using the following command line: file name may contain path information; it does not have to follow the GNAT file naming rules + Note that it is no longer necessary to specify the Ada language version; + ``gnatpp`` can process Ada source code written in any version from + Ada 83 onward without specifying any language version switch. + .. _Switches_for_gnatpp: @@ -3633,30 +3648,6 @@ Alternatively, you may run the script using the following command line: all the immediate units of the argument project. - .. index:: --gnat83 (gnatpp) - - :switch:`--gnat83` - Ada 83 mode - - - .. index:: --gnat95 (gnatpp) - - :switch:`--gnat95` - Ada 95 mode - - - .. index:: --gnat2005 (gnatpp) - - :switch:`--gnat2005` - Ada 2005 mode - - - .. index:: --gnat2012 (gnatpp) - - :switch:`--gnat2012` - Ada 2012 mode - - .. _Formatting_Rules: Formatting Rules @@ -4243,6 +4234,10 @@ Alternatively, you may run the script using the following command line: or creates the name file to generate using the standard GNAT naming conventions. + Note that it is no longer necessary to specify the Ada language version; + ``gnatmetric`` can process Ada source code written in any version from + Ada 83 onward without specifying any language version switch. + * *switches* is an optional sequence of switches as described in the next section @@ -4402,30 +4397,6 @@ Alternatively, you may run the script using the following command line: * *b* - Brackets encoding (default value) - .. index:: --gnat83 (gnatstub) - - :switch:`--gnat83` - Ada 83 mode - - - .. index:: --gnat95 (gnatstub) - - :switch:`--gnat95` - Ada 95 mode - - - .. index:: --gnat2005 (gnatstub) - - :switch:`--gnat2005` - Ada 2005 mode - - - .. index:: --gnat2012 (gnatstub) - - :switch:`--gnat2012` - Ada 2012 mode - - .. index:: --quiet (gnatstub) .. index:: -q (gnatstub) -- cgit v1.1 From 18ba4b0dbd971fc879c8db3cbe50726c8bd7c25e Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Mon, 12 Aug 2019 09:01:14 +0000 Subject: [Ada] Prevent crash in Put_Scaled This patch fixes a bug in Put_Scaled, which causes a crash when checks are on. 2019-08-12 Bob Duff gcc/ada/ * libgnat/a-tifiio.adb (Put_Scaled): Prevent AA from being negative, since Field is range 0 .. something. From-SVN: r274300 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/libgnat/a-tifiio.adb | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1bf7e6d..97f3141 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2019-08-12 Bob Duff + * libgnat/a-tifiio.adb (Put_Scaled): Prevent AA from being + negative, since Field is range 0 .. something. + +2019-08-12 Bob Duff + * doc/gnat_ugn/gnat_utility_programs.rst (gnatmetric, gnatpp, gnatstub): Remove documentation for Ada language version switches, and note that they are no longer needed. diff --git a/gcc/ada/libgnat/a-tifiio.adb b/gcc/ada/libgnat/a-tifiio.adb index 1c817ea8..d048646 100644 --- a/gcc/ada/libgnat/a-tifiio.adb +++ b/gcc/ada/libgnat/a-tifiio.adb @@ -560,7 +560,7 @@ package body Ada.Text_IO.Fixed_IO is E : Integer) is pragma Assert (E >= -Max_Digits); - AA : constant Field := E + A; + AA : constant Field := Integer'Max (E + A, 0); N : constant Natural := (AA + Max_Digits - 1) / Max_Digits + 1; Q : array (0 .. N - 1) of Int64 := (others => 0); -- cgit v1.1 From 39571eeaeb6e993f259cc603c64d5483be5afc65 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Mon, 12 Aug 2019 09:01:20 +0000 Subject: [Ada] Prevent crash in Is_Reachable This patch fixes a bug in Is_Reachable, which causes a crash when checks are on. 2019-08-12 Bob Duff gcc/ada/ * libgnat/a-cbmutr.adb (Is_Reachable): Declare Idx to be of the base subtype. Clearly it makes no sense to loop "while Idx >= 0", if Idx is of a nonnegative subtype. From-SVN: r274301 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/libgnat/a-cbmutr.adb | 4 +--- 2 files changed, 7 insertions(+), 3 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 97f3141..4922e46 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,11 @@ 2019-08-12 Bob Duff + * libgnat/a-cbmutr.adb (Is_Reachable): Declare Idx to be of the + base subtype. Clearly it makes no sense to loop "while Idx >= + 0", if Idx is of a nonnegative subtype. + +2019-08-12 Bob Duff + * libgnat/a-tifiio.adb (Put_Scaled): Prevent AA from being negative, since Field is range 0 .. something. diff --git a/gcc/ada/libgnat/a-cbmutr.adb b/gcc/ada/libgnat/a-cbmutr.adb index cdc2629..fb8585a 100644 --- a/gcc/ada/libgnat/a-cbmutr.adb +++ b/gcc/ada/libgnat/a-cbmutr.adb @@ -1767,10 +1767,8 @@ package body Ada.Containers.Bounded_Multiway_Trees is (Container : Tree; From, To : Count_Type) return Boolean is - Idx : Count_Type; - + Idx : Count_Type'Base := From; begin - Idx := From; while Idx >= 0 loop if Idx = To then return True; -- cgit v1.1 From ad430786085ad3e5fee751414799d8ccae60fbc3 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Mon, 12 Aug 2019 09:01:25 +0000 Subject: [Ada] Do not suppress checks in instances of internal generics This patch removes suppression of checks in nested instances of internal packages. No test. This was inconsistent: only for packages, not for subprograms. Only for nested instantiations, not library level ones. Not for GNAT units. Furthermore, the user should have control via pragma Suppress or switches. Furthermore, without this change, there could be missing tampering checks in Ada.Containers. 2019-08-12 Bob Duff gcc/ada/ * sem_ch12.adb (Instantiate_Package_Body): Remove suppression of checks in instances of internal units. * sem_ch6.adb (Analyze_Function_Return): Do not generate a constraint check on an extended_return_statement if the subtype of the return object in the statement is identical to the return subtype of the function. From-SVN: r274302 --- gcc/ada/ChangeLog | 9 +++++++++ gcc/ada/sem_ch12.adb | 20 +------------------- gcc/ada/sem_ch6.adb | 14 +++++++++++--- 3 files changed, 21 insertions(+), 22 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4922e46..f2870e8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,14 @@ 2019-08-12 Bob Duff + * sem_ch12.adb (Instantiate_Package_Body): Remove suppression of + checks in instances of internal units. + * sem_ch6.adb (Analyze_Function_Return): Do not generate a + constraint check on an extended_return_statement if the subtype + of the return object in the statement is identical to the return + subtype of the function. + +2019-08-12 Bob Duff + * libgnat/a-cbmutr.adb (Is_Reachable): Declare Idx to be of the base subtype. Clearly it makes no sense to loop "while Idx >= 0", if Idx is of a nonnegative subtype. diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 3aa4975..1f3a397 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -11601,25 +11601,7 @@ package body Sem_Ch12 is -- indicate that the body instance is to be delayed. Install_Body (Act_Body, Inst_Node, Gen_Body, Gen_Decl); - - -- Now analyze the body. We turn off all checks if this is an - -- internal unit, since there is no reason to have checks on for - -- any predefined run-time library code. All such code is designed - -- to be compiled with checks off. - - -- Note that we do NOT apply this criterion to children of GNAT - -- The latter units must suppress checks explicitly if needed. - - -- We also do not suppress checks in CodePeer mode where we are - -- interested in finding possible runtime errors. - - if not CodePeer_Mode - and then In_Predefined_Unit (Gen_Decl) - then - Analyze (Act_Body, Suppress => All_Checks); - else - Analyze (Act_Body); - end if; + Analyze (Act_Body); end if; Inherit_Context (Gen_Body, Inst_Node); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 3c026bf..e176535 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1056,9 +1056,17 @@ package body Sem_Ch6 is -- Apply constraint check. Note that this is done before the implicit -- conversion of the expression done for anonymous access types to -- ensure correct generation of the null-excluding check associated - -- with null-excluding expressions found in return statements. - - Apply_Constraint_Check (Expr, R_Type); + -- with null-excluding expressions found in return statements. We + -- don't need a check if the subtype of the return object is the + -- same as the result subtype of the function. + + if Nkind (N) /= N_Extended_Return_Statement + or else Nkind (Obj_Decl) /= N_Object_Declaration + or else Nkind (Object_Definition (Obj_Decl)) not in N_Has_Entity + or else Entity (Object_Definition (Obj_Decl)) /= R_Type + then + Apply_Constraint_Check (Expr, R_Type); + end if; -- The return value is converted to the return type of the function, -- which implies a predicate check if the return type is predicated. -- cgit v1.1 From 009070260dd9ac941d30b119638a6f3839eb2e6b Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 12 Aug 2019 09:01:33 +0000 Subject: [Ada] Fix internal error on comparison of unaligned slices This fixes an internal error in the code generator when it is trying to take the address of a slice which does not start on a byte boundary, in order to generate a comparison between slices with a dynamic length. This case is not supported by the code generator and comes from an explicit representation clause on a record type, so it must be detected and handled by the front-end by expanding the comparison on an element-by-element basis. 2019-08-12 Eric Botcazou gcc/ada/ * exp_ch4.adb (Expand_N_Op_Eq): Expand the array equality if either operand is a possibly unaligned slice. * exp_ch6.adb (Expand_Simple_Function_Return): Do not generate a copy for a possibly unaligned object if it is represented as a scalar. * exp_util.adb (Is_Possibly_Unaligned_Slice): Do not always return false if the target doesn't have strict alignment. gcc/testsuite/ * gnat.dg/slice10.adb: New testcase. From-SVN: r274303 --- gcc/ada/ChangeLog | 10 ++++++++++ gcc/ada/exp_ch4.adb | 2 ++ gcc/ada/exp_ch6.adb | 17 +++++++++-------- gcc/ada/exp_util.adb | 6 ------ 4 files changed, 21 insertions(+), 14 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f2870e8..fa543df 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2019-08-12 Eric Botcazou + + * exp_ch4.adb (Expand_N_Op_Eq): Expand the array equality if + either operand is a possibly unaligned slice. + * exp_ch6.adb (Expand_Simple_Function_Return): Do not generate a + copy for a possibly unaligned object if it is represented as a + scalar. + * exp_util.adb (Is_Possibly_Unaligned_Slice): Do not always + return false if the target doesn't have strict alignment. + 2019-08-12 Bob Duff * sem_ch12.adb (Instantiate_Package_Body): Remove suppression of diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 43be9c9..6f2fe32 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -8068,7 +8068,9 @@ package body Exp_Ch4 is and then not Is_Floating_Point_Type (Component_Type (Typl)) and then not Is_Atomic_Or_VFA (Component_Type (Typl)) and then not Is_Possibly_Unaligned_Object (Lhs) + and then not Is_Possibly_Unaligned_Slice (Lhs) and then not Is_Possibly_Unaligned_Object (Rhs) + and then not Is_Possibly_Unaligned_Slice (Rhs) and then Support_Composite_Compare_On_Target then null; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 3f2d0e3..4ba9d84 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -203,8 +203,8 @@ package body Exp_Ch6 is -- For all parameter modes, actuals that denote components and slices of -- packed arrays are expanded into suitable temporaries. -- - -- For non-scalar objects that are possibly unaligned, add call by copy - -- code (copy in for IN and IN OUT, copy out for OUT and IN OUT). + -- For nonscalar objects that are possibly unaligned, add call by copy code + -- (copy in for IN and IN OUT, copy out for OUT and IN OUT). -- -- For OUT and IN OUT parameters, add predicate checks after the call -- based on the predicates of the actual type. @@ -2019,7 +2019,7 @@ package body Exp_Ch6 is elsif Is_Ref_To_Bit_Packed_Array (Actual) then Add_Simple_Call_By_Copy_Code; - -- If a non-scalar actual is possibly bit-aligned, we need a copy + -- If a nonscalar actual is possibly bit-aligned, we need a copy -- because the back-end cannot cope with such objects. In other -- cases where alignment forces a copy, the back-end generates -- it properly. It should not be generated unconditionally in the @@ -2235,7 +2235,7 @@ package body Exp_Ch6 is elsif Is_Ref_To_Bit_Packed_Array (Actual) then Add_Simple_Call_By_Copy_Code; - -- If a non-scalar actual is possibly unaligned, we need a copy + -- If a nonscalar actual is possibly unaligned, we need a copy elsif Is_Possibly_Unaligned_Object (Actual) and then not Represented_As_Scalar (Etype (Formal)) @@ -7413,12 +7413,13 @@ package body Exp_Ch6 is end; end if; - -- If we are returning an object that may not be bit-aligned, then copy - -- the value into a temporary first. This copy may need to expand to a - -- loop of component operations. + -- If we are returning a nonscalar object that is possibly unaligned, + -- then copy the value into a temporary first. This copy may need to + -- expand to a loop of component operations. if Is_Possibly_Unaligned_Slice (Exp) - or else Is_Possibly_Unaligned_Object (Exp) + or else (Is_Possibly_Unaligned_Object (Exp) + and then not Represented_As_Scalar (Etype (Exp))) then declare ExpR : constant Node_Id := Relocate_Node (Exp); diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index b677a72..2a3132b 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -8485,12 +8485,6 @@ package body Exp_Util is return False; end if; - -- We only need to worry if the target has strict alignment - - if not Target_Strict_Alignment then - return False; - end if; - -- If it is a slice, then look at the array type being sliced declare -- cgit v1.1 From fba9fcae321660fdc760fd293d92970e52489706 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 12 Aug 2019 09:01:38 +0000 Subject: [Ada] Small comment tweaks for 3 predicates on bit-aligned references They fix a few glitches left and right. No functional changes. 2019-08-12 Eric Botcazou gcc/ada/ * exp_util.ads (Component_May_Be_Bit_Aligned): Small comment tweaks. (Possible_Bit_Aligned_Component): Likewise. (Type_May_Have_Bit_Aligned_Components): Likewise. * exp_util.adb (Component_May_Be_Bit_Aligned): Likewise. (Possible_Bit_Aligned_Component): Likewise. (Type_May_Have_Bit_Aligned_Components): Likewise. From-SVN: r274304 --- gcc/ada/ChangeLog | 10 ++++++++++ gcc/ada/exp_util.adb | 36 ++++++++++++++++++++++------------- gcc/ada/exp_util.ads | 54 ++++++++++++++++++++++++---------------------------- 3 files changed, 58 insertions(+), 42 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fa543df..64f4c6b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,15 @@ 2019-08-12 Eric Botcazou + * exp_util.ads (Component_May_Be_Bit_Aligned): Small comment + tweaks. + (Possible_Bit_Aligned_Component): Likewise. + (Type_May_Have_Bit_Aligned_Components): Likewise. + * exp_util.adb (Component_May_Be_Bit_Aligned): Likewise. + (Possible_Bit_Aligned_Component): Likewise. + (Type_May_Have_Bit_Aligned_Components): Likewise. + +2019-08-12 Eric Botcazou + * exp_ch4.adb (Expand_N_Op_Eq): Expand the array equality if either operand is a possibly unaligned slice. * exp_ch6.adb (Expand_Simple_Function_Return): Do not generate a diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 2a3132b..41708c3 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -4444,8 +4444,8 @@ package body Exp_Util is begin -- If no component clause, then everything is fine, since the back end - -- never bit-misaligns by default, even if there is a pragma Packed for - -- the record. + -- never misaligns from byte boundaries by default, even if there is a + -- pragma Pack for the record. if No (Comp) or else No (Component_Clause (Comp)) then return False; @@ -10707,9 +10707,9 @@ package body Exp_Util is Ptyp : constant Entity_Id := Etype (P); begin - -- If we know the component size and it is less than 64, then - -- we are definitely OK. The back end always does assignment of - -- misaligned small objects correctly. + -- If we know the component size and it is not larger than 64, + -- then we are definitely OK. The back end does the assignment + -- of misaligned small objects correctly. if Known_Static_Component_Size (Ptyp) and then Component_Size (Ptyp) <= 64 @@ -10732,13 +10732,15 @@ package body Exp_Util is Comp : constant Entity_Id := Entity (Selector_Name (N)); begin - -- If there is no component clause, then we are in the clear - -- since the back end will never misalign a large component - -- unless it is forced to do so. In the clear means we need - -- only the recursive test on the prefix. + -- This is the crucial test: if the component itself causes + -- trouble, then we can stop and return True. if Component_May_Be_Bit_Aligned (Comp) then return True; + + -- Otherwise, we need to test the prefix, to see if we are + -- selecting from a possibly unaligned component. + else return Possible_Bit_Aligned_Component (P); end if; @@ -10751,7 +10753,7 @@ package body Exp_Util is return Possible_Bit_Aligned_Component (Prefix (N)); -- For an unchecked conversion, check whether the expression may - -- be bit-aligned. + -- be bit aligned. when N_Unchecked_Type_Conversion => return Possible_Bit_Aligned_Component (Expression (N)); @@ -13505,9 +13507,17 @@ package body Exp_Util is begin E := First_Component_Or_Discriminant (Typ); while Present (E) loop - if Component_May_Be_Bit_Aligned (E) - or else Type_May_Have_Bit_Aligned_Components (Etype (E)) - then + -- This is the crucial test: if the component itself causes + -- trouble, then we can stop and return True. + + if Component_May_Be_Bit_Aligned (E) then + return True; + end if; + + -- Otherwise, we need to test its type, to see if it may + -- itself contain a troublesome component. + + if Type_May_Have_Bit_Aligned_Components (Etype (E)) then return True; end if; diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index c0848c7..30a3c71 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -401,32 +401,27 @@ package Exp_Util is -- case overflow. function Component_May_Be_Bit_Aligned (Comp : Entity_Id) return Boolean; - -- This function is in charge of detecting record components that may - -- cause trouble in the back end if an attempt is made to assign the - -- component. The back end can handle such assignments with no problem if - -- the components involved are small (64-bits or less) records or scalar - -- items (including bit-packed arrays represented with modular types) or - -- are both aligned on a byte boundary (starting on a byte boundary, and - -- occupying an integral number of bytes). + -- This function is in charge of detecting record components that may cause + -- trouble for the back end if an attempt is made to access the component + -- as a whole. The back end can handle such accesses with no problem if the + -- components involved are small (64 bits or less) records or scalar items + -- (including bit-packed arrays represented with a modular type), or else + -- if they are aligned on byte boundaries (i.e. starting on a byte boundary + -- and occupying an integral number of bytes). -- -- However, problems arise for records larger than 64 bits, or for arrays -- (other than bit-packed arrays represented with a modular type) if the - -- component starts on a non-byte boundary, or does not occupy an integral - -- number of bytes (i.e. there are some bits possibly shared with fields - -- at the start or beginning of the component). The back end cannot handle - -- loading and storing such components in a single operation. + -- component either does not start on a byte boundary or does not occupy an + -- integral number of bytes (i.e. there are some bits possibly shared with + -- other components at the start or the end of the component). The back end + -- cannot handle loading from or storing to such components as a whole. -- - -- This function is used to detect the troublesome situation. it is - -- conservative in the sense that it produces True unless it knows for - -- sure that the component is safe (as outlined in the first paragraph - -- above). The code generation for record and array assignment checks for - -- trouble using this function, and if so the assignment is generated + -- This function is used to detect the troublesome situation. It is meant + -- to be conservative in the sense that it produces True unless it knows + -- for sure that the component is safe (as outlined in the first paragraph + -- above). The processing for record and array assignment indirectly checks + -- for trouble using this function and, if so, the assignment is expanded -- component-wise, which the back end is required to handle correctly. - -- - -- Note that in GNAT 3, the back end will reject such components anyway, - -- so the hard work in checking for this case is wasted in GNAT 3, but - -- it is harmless, so it is easier to do it in all cases, rather than - -- conditionalize it in GNAT 5 or beyond. function Containing_Package_With_Ext_Axioms (E : Entity_Id) return Entity_Id; @@ -962,12 +957,12 @@ package Exp_Util is -- returned only if the replacement is safe. function Possible_Bit_Aligned_Component (N : Node_Id) return Boolean; - -- This function is used during processing the assignment of a record or - -- indexed component. The argument N is either the left hand or right hand - -- side of an assignment, and this function determines if there is a record - -- component reference where the record may be bit aligned in a manner that - -- causes trouble for the back end (see Component_May_Be_Bit_Aligned for - -- further details). + -- This function is used during processing the assignment of a record or an + -- array, or the construction of an aggregate. The argument N is either the + -- left or the right hand side of an assignment and the function determines + -- whether there is a record component reference where the component may be + -- bit aligned in a manner that causes trouble for the back end (see also + -- Component_May_Be_Bit_Aligned for further details). function Power_Of_Two (N : Node_Id) return Nat; -- Determines if N is a known at compile time value which is of the form @@ -1170,8 +1165,9 @@ package Exp_Util is function Type_May_Have_Bit_Aligned_Components (Typ : Entity_Id) return Boolean; -- Determines if Typ is a composite type that has within it (looking down - -- recursively at any subcomponents), a record type which has component - -- that may be bit aligned (see Possible_Bit_Aligned_Component). The result + -- recursively at subcomponents) a record which contains a component that + -- may be bit aligned in a manner that causes trouble for the back end + -- (see also Component_May_Be_Bit_Aligned for further details). The result -- is conservative, in that a result of False is decisive. A result of True -- means that such a component may or may not be present. -- cgit v1.1 From 8e4ca4fcffbe6d3855f67cd02e0bb2a40d62fa10 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 12 Aug 2019 09:01:43 +0000 Subject: [Ada] Crash on illegal left-hand side in assignment of renamed variable This patch fixes a crash on an assignment where the left-hand side is a renaming of a function call that does not involve ceiling priorities. This avoids a compiler crash in some cases, and prevents a useless retrieval and compilation of run-time packages. 2019-08-12 Ed Schonberg gcc/ada/ * sem_util.adb (Is_Expaned_Priority_Attribute): Check whether call comes from a rewritten attribute before comparing name with Get_Ceiling run-time subprogram. gcc/testsuite/ * gnat.dg/renaming15.adb: New testcase. From-SVN: r274305 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/sem_util.adb | 1 + 2 files changed, 7 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 64f4c6b..74ceb50 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-12 Ed Schonberg + + * sem_util.adb (Is_Expaned_Priority_Attribute): Check whether + call comes from a rewritten attribute before comparing name with + Get_Ceiling run-time subprogram. + 2019-08-12 Eric Botcazou * exp_util.ads (Component_May_Be_Bit_Aligned): Small comment diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 42085c7..54ac0a4 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -14669,6 +14669,7 @@ package body Sem_Util is return Nkind (E) = N_Function_Call and then not Configurable_Run_Time_Mode + and then Nkind (Original_Node (E)) = N_Attribute_Reference and then (Entity (Name (E)) = RTE (RE_Get_Ceiling) or else Entity (Name (E)) = RTE (RO_PE_Get_Ceiling)); end Is_Expanded_Priority_Attribute; -- cgit v1.1 From 68e4cc9854044a2f66623c5d8dd36bc27bd948f2 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 12 Aug 2019 09:01:48 +0000 Subject: [Ada] Missing check on outbound parameter of a non-null access type This patch adds code to generate proper post-call checks when an actual for an in-out or out parameter has a non-null access type. No constraints are applied to an inbound access parameter, but on exit a not-null check must be performed if the type of the actual requires it. 2019-08-12 Ed Schonberg gcc/ada/ * exp_ch6.adb (Expand_Actuals. Add_Call_By_Copy_Code): Add code to generate proper checks when an actual for an in-out or out parameter has a non-null access type. No constraints are applied to an inbound access parameter, but on exit a not-null check must be performed if the type of the actual requires it. gcc/testsuite/ * gnat.dg/null_check.adb: New testcase. From-SVN: r274306 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/exp_ch6.adb | 33 ++++++++++++++++++++++++++++++--- 2 files changed, 38 insertions(+), 3 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 74ceb50..c62e621 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,13 @@ 2019-08-12 Ed Schonberg + * exp_ch6.adb (Expand_Actuals. Add_Call_By_Copy_Code): Add code + to generate proper checks when an actual for an in-out or out + parameter has a non-null access type. No constraints are + applied to an inbound access parameter, but on exit a not-null + check must be performed if the type of the actual requires it. + +2019-08-12 Ed Schonberg + * sem_util.adb (Is_Expaned_Priority_Attribute): Check whether call comes from a rewritten attribute before comparing name with Get_Ceiling run-time subprogram. diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 4ba9d84..8d5a70db 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -1406,6 +1406,16 @@ package body Exp_Ch6 is Init := New_Occurrence_Of (Var, Loc); end if; + -- Access types are passed in without checks, but if a copy-back is + -- required for a null-excluding check on an in-out or out parameter, + -- then the initial value is that of the actual. + + elsif Is_Access_Type (E_Formal) + and then Can_Never_Be_Null (Etype (Actual)) + and then not Can_Never_Be_Null (E_Formal) + then + Init := New_Occurrence_Of (Var, Loc); + else Init := Empty; end if; @@ -1544,6 +1554,19 @@ package body Exp_Ch6 is Type_Access_Level (E_Formal)))); else + if Is_Access_Type (E_Formal) + and then Can_Never_Be_Null (Etype (Actual)) + and then not Can_Never_Be_Null (E_Formal) + then + Append_To (Post_Call, + Make_Raise_Constraint_Error (Loc, + Condition => + Make_Op_Eq (Loc, + Left_Opnd => New_Occurrence_Of (Temp, Loc), + Right_Opnd => Make_Null (Loc)), + Reason => CE_Access_Check_Failed)); + end if; + Append_To (Post_Call, Make_Assignment_Statement (Loc, Name => Lhs, @@ -1942,7 +1965,8 @@ package body Exp_Ch6 is Apply_Constraint_Check (Actual, E_Formal); -- Out parameter case. No constraint checks on access type - -- RM 6.4.1 (13) + -- RM 6.4.1 (13), but on return a null-excluding check may be + -- required (see below). elsif Is_Access_Type (E_Formal) then null; @@ -2049,11 +2073,14 @@ package body Exp_Ch6 is -- formal subtype are not the same, requiring a check. -- It is necessary to exclude tagged types because of "downward - -- conversion" errors. + -- conversion" errors, but null-excluding checks on return may be + -- required. elsif Is_Access_Type (E_Formal) - and then not Same_Type (E_Formal, E_Actual) and then not Is_Tagged_Type (Designated_Type (E_Formal)) + and then (not Same_Type (E_Formal, E_Actual) + or else (Can_Never_Be_Null (E_Actual) + and then not Can_Never_Be_Null (E_Formal))) then Add_Call_By_Copy_Code; -- cgit v1.1 From 4a2e9be1ac7c8f4c37b5deb4ce0b0f39925e56c9 Mon Sep 17 00:00:00 2001 From: Dmitriy Anisimkov Date: Mon, 12 Aug 2019 09:01:53 +0000 Subject: [Ada] New parameter Quiet for procedure GNAT.Command_Line.Getopt Getopt procedure is parsing the command line or set of strings. If the command line contains unknown switch than the Getopt prints error message to the console and raises the exception Invalid_Switch. The printing can be inappropriate in some cases. The new parameter Quiet allows avoiding console output. 2019-08-12 Dmitriy Anisimkov gcc/ada/ * libgnat/g-comlin.ads, libgnat/g-comlin.adb (Getopt): Add parameter Quiet. Need to do not output error messages to console. Invalid_Switch exception generation surrounded by an error message. From-SVN: r274307 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/libgnat/g-comlin.adb | 23 ++++++++++++++--------- gcc/ada/libgnat/g-comlin.ads | 4 +++- 3 files changed, 24 insertions(+), 10 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c62e621..8b8a944 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-08-12 Dmitriy Anisimkov + + * libgnat/g-comlin.ads, libgnat/g-comlin.adb (Getopt): Add + parameter Quiet. Need to do not output error messages to + console. Invalid_Switch exception generation surrounded by an + error message. + 2019-08-12 Ed Schonberg * exp_ch6.adb (Expand_Actuals. Add_Call_By_Copy_Code): Add code diff --git a/gcc/ada/libgnat/g-comlin.adb b/gcc/ada/libgnat/g-comlin.adb index 29100af..f567ddb 100644 --- a/gcc/ada/libgnat/g-comlin.adb +++ b/gcc/ada/libgnat/g-comlin.adb @@ -753,7 +753,8 @@ package body GNAT.Command_Line is Parser.Current_Index := End_Index + 1; - raise Invalid_Switch; + raise Invalid_Switch with + "Unrecognized option " & Full_Switch (Parser); end if; End_Index := Parser.Current_Index + Max_Length - 1; @@ -883,7 +884,8 @@ package body GNAT.Command_Line is Last => Arg'Last, Extra => Parser.Switch_Character); Parser.Current_Index := Arg'Last + 1; - raise Invalid_Switch; + raise Invalid_Switch with + "Unrecognized option " & Full_Switch (Parser); end if; end case; @@ -3365,7 +3367,8 @@ package body GNAT.Command_Line is (Config : Command_Line_Configuration; Callback : Switch_Handler := null; Parser : Opt_Parser := Command_Line_Parser; - Concatenate : Boolean := True) + Concatenate : Boolean := True; + Quiet : Boolean := False) is Local_Config : Command_Line_Configuration := Config; Getopt_Switches : String_Access; @@ -3575,12 +3578,14 @@ package body GNAT.Command_Line is -- Message inspired by "ls" on Unix - Put_Line (Standard_Error, - Base_Name (Ada.Command_Line.Command_Name) - & ": unrecognized option '" - & Full_Switch (Parser) - & "'"); - Try_Help; + if not Quiet then + Put_Line (Standard_Error, + Base_Name (Ada.Command_Line.Command_Name) + & ": unrecognized option '" + & Full_Switch (Parser) + & "'"); + Try_Help; + end if; raise; diff --git a/gcc/ada/libgnat/g-comlin.ads b/gcc/ada/libgnat/g-comlin.ads index f1251b6..3708c37 100644 --- a/gcc/ada/libgnat/g-comlin.ads +++ b/gcc/ada/libgnat/g-comlin.ads @@ -738,7 +738,8 @@ package GNAT.Command_Line is (Config : Command_Line_Configuration; Callback : Switch_Handler := null; Parser : Opt_Parser := Command_Line_Parser; - Concatenate : Boolean := True); + Concatenate : Boolean := True; + Quiet : Boolean := False); -- Similar to the standard Getopt function. For each switch found on the -- command line, this calls Callback, if the switch is not handled -- automatically. @@ -756,6 +757,7 @@ package GNAT.Command_Line is -- to display the help message and raises Exit_From_Command_Line. -- If an invalid switch is specified on the command line, this procedure -- will display an error message and raises Invalid_Switch again. + -- If the Quiet parameter is True then the error message is not displayed. -- -- This function automatically expands switches: -- -- cgit v1.1 From 8467866f26927d46be47240308278a867e3fb2b0 Mon Sep 17 00:00:00 2001 From: Dmitriy Anisimkov Date: Mon, 12 Aug 2019 09:01:58 +0000 Subject: [Ada] Fix IPv6 numeric address detection IPv6 numeric address can't have less than 2 colons. It fixes the error when Get_Host_By_Name called with hostname composed by only hexadecimal symbols. 2019-08-12 Dmitriy Anisimkov gcc/ada/ * libgnat/g-socket.adb (Is_IPv6_Address): Check that no less then 2 colons in IPv6 numeric address. From-SVN: r274308 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/libgnat/g-socket.adb | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8b8a944..e603f04 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2019-08-12 Dmitriy Anisimkov + * libgnat/g-socket.adb (Is_IPv6_Address): Check that no less + then 2 colons in IPv6 numeric address. + +2019-08-12 Dmitriy Anisimkov + * libgnat/g-comlin.ads, libgnat/g-comlin.adb (Getopt): Add parameter Quiet. Need to do not output error messages to console. Invalid_Switch exception generation surrounded by an diff --git a/gcc/ada/libgnat/g-socket.adb b/gcc/ada/libgnat/g-socket.adb index ceb2cb0..51817ea 100644 --- a/gcc/ada/libgnat/g-socket.adb +++ b/gcc/ada/libgnat/g-socket.adb @@ -1797,7 +1797,7 @@ package body GNAT.Sockets is end if; end loop; - return Colons <= 8; + return Colons in 2 .. 8; end Is_IPv6_Address; --------------------- -- cgit v1.1 From dfa6d55af715a2b902d6ed30f2c0276b1709dd5b Mon Sep 17 00:00:00 2001 From: Claire Dross Date: Tue, 13 Aug 2019 08:06:12 +0000 Subject: [Ada] Extend range type in search primitives of formal vectors 2019-08-13 Claire Dross gcc/ada/ * libgnat/a-cfinve.adb, libgnat/a-cofove.adb (Find_Index, Reverse_Find_Index): Use bigger type to avoid range check failure at the last loop iteration. From-SVN: r274331 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/libgnat/a-cfinve.adb | 4 ++-- gcc/ada/libgnat/a-cofove.adb | 4 ++-- 3 files changed, 10 insertions(+), 4 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e603f04..892cbbf 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-13 Claire Dross + + * libgnat/a-cfinve.adb, libgnat/a-cofove.adb (Find_Index, + Reverse_Find_Index): Use bigger type to avoid range check + failure at the last loop iteration. + 2019-08-12 Dmitriy Anisimkov * libgnat/g-socket.adb (Is_IPv6_Address): Check that no less diff --git a/gcc/ada/libgnat/a-cfinve.adb b/gcc/ada/libgnat/a-cfinve.adb index 36df8e6..a187128 100644 --- a/gcc/ada/libgnat/a-cfinve.adb +++ b/gcc/ada/libgnat/a-cfinve.adb @@ -457,7 +457,7 @@ is Item : Element_Type; Index : Index_Type := Index_Type'First) return Extended_Index is - K : Capacity_Range; + K : Count_Type; Last : constant Index_Type := Last_Index (Container); begin @@ -1277,7 +1277,7 @@ is Index : Index_Type := Index_Type'Last) return Extended_Index is Last : Index_Type'Base; - K : Capacity_Range; + K : Count_Type'Base; begin if Index > Last_Index (Container) then diff --git a/gcc/ada/libgnat/a-cofove.adb b/gcc/ada/libgnat/a-cofove.adb index c848ad8..3a10d32 100644 --- a/gcc/ada/libgnat/a-cofove.adb +++ b/gcc/ada/libgnat/a-cofove.adb @@ -378,7 +378,7 @@ is Item : Element_Type; Index : Index_Type := Index_Type'First) return Extended_Index is - K : Capacity_Range; + K : Count_Type; Last : constant Index_Type := Last_Index (Container); begin @@ -1147,7 +1147,7 @@ is Index : Index_Type := Index_Type'Last) return Extended_Index is Last : Index_Type'Base; - K : Capacity_Range; + K : Count_Type'Base; begin if Index > Last_Index (Container) then -- cgit v1.1 From 96cdd379c398499f0b19e3b469b72b77857995c6 Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Tue, 13 Aug 2019 08:06:18 +0000 Subject: [Ada] Complete the more extended AST traversal used in GNATprove Following the work on the Ada 202X feature of iterated aggregates (AI12-061), Loop_Actions should have been listed as a semantic field of nodes of kind N_Iterated_Component_Association. Fix this as well as the new extended AST traversal which should traverse these fields. There is no impact on compilation. 2019-08-13 Yannick Moy gcc/ada/ * sem_util.adb (Traverse_More_Func): Take into account Loop_Actions inside N_Iterated_Component_Association nodes. * sinfo.ads: Document correctly Loop_Actions as a field of nodes of kind N_Iterated_Component_Association. From-SVN: r274332 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/sem_util.adb | 3 +++ gcc/ada/sinfo.ads | 2 +- 3 files changed, 11 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 892cbbf..5b88950 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-08-13 Yannick Moy + + * sem_util.adb (Traverse_More_Func): Take into account + Loop_Actions inside N_Iterated_Component_Association nodes. + * sinfo.ads: Document correctly Loop_Actions as a field of nodes + of kind N_Iterated_Component_Association. + 2019-08-13 Claire Dross * libgnat/a-cfinve.adb, libgnat/a-cofove.adb (Find_Index, diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 54ac0a4..4f20eaa 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -25580,6 +25580,9 @@ package body Sem_Util is when N_Case_Expression_Alternative => Traverse_More (Actions (Node), Result); + when N_Iterated_Component_Association => + Traverse_More (Loop_Actions (Node), Result); + when N_Iteration_Scheme => Traverse_More (Condition_Actions (Node), Result); diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 064147e..e3f7fd3 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -11959,7 +11959,7 @@ package Sinfo is N_Iterated_Component_Association => (1 => True, -- Defining_Identifier (Node1) - 2 => False, -- unused + 2 => True, -- Loop_Actions (List2-Sem) 3 => True, -- Expression (Node3) 4 => True, -- Discrete_Choices (List4) 5 => False), -- unused -- cgit v1.1 From e0401824f74645adcd008045190e0d86ae3ce8e0 Mon Sep 17 00:00:00 2001 From: Dmitriy Anisimkov Date: Tue, 13 Aug 2019 08:06:24 +0000 Subject: [Ada] Better exception message on Invalid_Switch exception Improve the error message introduced in the recent commit for Invalid_Switch exception. 2019-08-13 Dmitriy Anisimkov gcc/ada/ * libgnat/g-comlin.adb (Getopt): Quote unrecognized switch in Invalid_Switch exception message. From-SVN: r274333 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/libgnat/g-comlin.adb | 4 ++-- 2 files changed, 7 insertions(+), 2 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5b88950..eab24a0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-13 Dmitriy Anisimkov + + * libgnat/g-comlin.adb (Getopt): Quote unrecognized switch in + Invalid_Switch exception message. + 2019-08-13 Yannick Moy * sem_util.adb (Traverse_More_Func): Take into account diff --git a/gcc/ada/libgnat/g-comlin.adb b/gcc/ada/libgnat/g-comlin.adb index f567ddb..e3fac5b 100644 --- a/gcc/ada/libgnat/g-comlin.adb +++ b/gcc/ada/libgnat/g-comlin.adb @@ -754,7 +754,7 @@ package body GNAT.Command_Line is Parser.Current_Index := End_Index + 1; raise Invalid_Switch with - "Unrecognized option " & Full_Switch (Parser); + "Unrecognized option '" & Full_Switch (Parser) & '''; end if; End_Index := Parser.Current_Index + Max_Length - 1; @@ -885,7 +885,7 @@ package body GNAT.Command_Line is Extra => Parser.Switch_Character); Parser.Current_Index := Arg'Last + 1; raise Invalid_Switch with - "Unrecognized option " & Full_Switch (Parser); + "Unrecognized option '" & Full_Switch (Parser) & '''; end if; end case; -- cgit v1.1 From 4c19aa690451fbd5d84ce1534a903163e67182e3 Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Tue, 13 Aug 2019 08:06:29 +0000 Subject: [Ada] Add ability to list compiler switches with gnatcmd This patch adds a new switch (--help-ada) to gnatcmd for displaying all the availible build flags as well as fixing some minor differences in output between implicit and explicit help for gnatcmd (e.g. "gnat" vs "gnat --help"). $ gnat GNAT Pro 20.0w (19940713) Copyright 1996-2019, Free Software Foundation, Inc. To list Ada build switches use --help-ada List of available commands gnat bind gnatbind gnat chop gnatchop gnat clean gnatclean gnat compile gnatmake -f -u -c gnat check gnatcheck gnat elim gnatelim gnat find gnatfind gnat krunch gnatkr gnat link gnatlink gnat list gnatls gnat make gnatmake gnat metric gnatmetric gnat name gnatname gnat preprocess gnatprep gnat pretty gnatpp gnat stack gnatstack gnat stub gnatstub gnat test gnattest gnat xref gnatxref Report bugs to report@adacore.com $ gnat --help GNAT Pro 20.0w (19940713) Copyright 1996-2019, Free Software Foundation, Inc. To list Ada build switches use --help-ada List of available commands gnat bind gnatbind gnat chop gnatchop gnat clean gnatclean gnat compile gnatmake -f -u -c gnat check gnatcheck gnat elim gnatelim gnat find gnatfind gnat krunch gnatkr gnat link gnatlink gnat list gnatls gnat make gnatmake gnat metric gnatmetric gnat name gnatname gnat preprocess gnatprep gnat pretty gnatpp gnat stack gnatstack gnat stub gnatstub gnat test gnattest gnat xref gnatxref Report bugs to report@adacore.com $ gnat --help-ada Usage: gnat switches sfile sfile Source file name -g Generate debugging information -Idir Specify source files search path -I- Do not look for sources in current directory -O[0123] Control the optimization level -gnata Assertions enabled. Pragma Assert/Debug to be activated -gnatA Avoid processing gnat.adc, if present file will be ignored -gnatb Generate brief messages to stderr even if verbose mode set -gnatB Assume no bad (invalid) values except in 'Valid attribute -gnatc Check syntax and semantics only (no code generation) -gnatC Generate CodePeer intermediate format (no code generation) -gnatd? Compiler debug option ? ([.]a-z,A-Z,0-9), see debug.adb -gnatD Debug expanded generated code (max line length = 72) -gnatDnn Debug expanded generated code (max line length = nn) -gnateA Aliasing checks on subprogram parameters -gnatec=? Specify configuration pragmas file, e.g. -gnatec=/x/f.adc -gnateC Generate CodePeer messages (ignored without -gnatcC) -gnated Disable synchronization of atomic variables -gnateD? Define or redefine preprocessing symbol, e.g. -gnateDsym=val -gnateE Generate extra information in exception messages -gnatef Full source path in brief error messages -gnateF Check overflow on predefined Float types -gnateG Generate preprocessed source -gnateinn Set maximum number of instantiations to nn -gnateInn Index in multi-unit source, e.g. -gnateI2 -gnatel Turn on info messages on generated Elaborate[_All] pragmas -gnateL Turn off info messages on generated Elaborate[_All] pragmas -gnatem=? Specify mapping file, e.g. -gnatem=mapping -gnatep=? Specify preprocessing data file, e.g. -gnatep=prep.data -gnateP Pure/Prelaborate errors generate warnings rather than errors -gnateS Generate SCO (Source Coverage Obligation) information -gnatet=? Write target dependent information file ?, e.g. gnatet=tdf -gnateT=? Read target dependent information file ?, e.g. gnateT=tdf -gnateu Ignore unrecognized style/validity/warning switches -gnateV Validity checks on subprogram parameters -gnateY Ignore all Style_Checks pragmas in source -gnatE Dynamic elaboration checking mode enabled -gnatf Full errors. Verbose details, all undefined references -gnatF Force all import/export external names to all uppercase -gnatg GNAT implementation mode (used for compiling GNAT units) -gnatG Output generated expanded code (max line length = 72) -gnatGnn Output generated expanded code (max line length = nn) -gnath Output this usage (help) information -gnatH Legacy elaboration checking mode enabled -gnati? Identifier char set (?=1/2/3/4/5/8/9/p/f/n/w) -gnatI Ignore all representation clauses -gnatjnn Format error and warning messages to fit nn character lines -gnatJ Relaxed elaboration checking mode enabled -gnatk Limit file names to nn characters (k = krunch) -gnatl Output full source listing with embedded error messages -gnatl=f Output full source listing to specified file -gnatL List corresponding source text in -gnatG or -gnatD output -gnatmnn Limit number of detected errors/warnings to nn (1-999999) -gnatn[?] Enable pragma Inline across units (?=1/2 for moderate/full) -gnato0 Disable overflow checking -gnato Enable overflow checking in STRICT (-gnato1) mode (default) -gnato? Enable overflow checks in STRICT/MINIMIZED/ELIMINATED (1/2/3) mode -gnato?? Set mode for general/assertion expressions separately -gnatp Suppress all checks -gnatP Generate periodic calls to System.Polling.Poll -gnatq Don't quit, try semantics, even if parse errors -gnatQ Don't quit, write ali/tree file even if compile errors -gnatr Treat pragma Restrictions as Restriction_Warnings -gnatR? List rep info (?=0/1/2/3/4/e/m for none/types/all/sym/cg/ext/mech) -gnatR?j List rep info in the JSON data interchange format -gnatR?s List rep info to file.rep instead of standard output -gnats Syntax check only -gnatS Print listing of package Standard -gnatt Tree output file to be generated -gnatTnn All compiler tables start at nn times usual starting size -gnatu List units for this compilation -gnatU Enable unique tag for error messages -gnatv Verbose mode. Full error output with source lines to stdout -gnatVxx Enable selected validity checking mode, xx = list of parameters: a turn on all validity checking options c turn on checking for copies C turn off checking for copies d turn on default (RM) checking D turn off default (RM) checking e turn on checking for elementary components E turn off checking for elementary components f turn on checking for floating-point F turn off checking for floating-point i turn on checking for in params I turn off checking for in params m turn on checking for in out params M turn off checking for in out params n turn off all validity checks (including RM) o turn on checking for operators/attributes O turn off checking for operators/attributes p turn on checking for parameters P turn off checking for parameters r turn on checking for returns R turn off checking for returns s turn on checking for subscripts S turn off checking for subscripts t turn on checking for tests T turn off checking for tests -gnatwxx Enable selected warning modes, xx = list of parameters: * indicates default setting + indicates warning flag included in -gnatwa a turn on all info/warnings marked below with + A turn off all optional info/warnings .a*+ turn on warnings for failing assertion .A turn off warnings for failing assertion _a*+ turn on warnings for anonymous allocators _A turn off warnings for anonymous allocators b+ turn on warnings for bad fixed value (not multiple of small) B* turn off warnings for bad fixed value (not multiple of small) .b*+ turn on warnings for biased representation .B turn off warnings for biased representation c+ turn on warnings for constant conditional C* turn off warnings for constant conditional .c+ turn on warnings for unrepped components .C* turn off warnings for unrepped components d turn on warnings for implicit dereference D* turn off warnings for implicit dereference .d turn on tagging of warnings with -gnatw switch .D* turn off tagging of warnings with -gnatw switch e treat all warnings (but not info) as errors .e turn on every optional info/warning (no exceptions) E treat all run-time warnings as errors f+ turn on warnings for unreferenced formal F* turn off warnings for unreferenced formal .f turn on warnings for suspicious Subp'Access .F* turn off warnings for suspicious Subp'Access g*+ turn on warnings for unrecognized pragma G turn off warnings for unrecognized pragma .g turn on GNAT warnings h turn on warnings for hiding declarations H* turn off warnings for hiding declarations .h turn on warnings for holes in records .H* turn off warnings for holes in records i*+ turn on warnings for implementation unit I turn off warnings for implementation unit .i*+ turn on warnings for overlapping actuals .I turn off warnings for overlapping actuals j+ turn on warnings for obsolescent (annex J) feature J* turn off warnings for obsolescent (annex J) feature .j+ turn on warnings for late dispatching primitives .J* turn off warnings for late dispatching primitives k+ turn on warnings on constant variable K* turn off warnings on constant variable .k turn on warnings for standard redefinition .K* turn off warnings for standard redefinition l turn on warnings for elaboration problems L* turn off warnings for elaboration problems .l turn on info messages for inherited aspects .L* turn off info messages for inherited aspects m+ turn on warnings for variable assigned but not read M* turn off warnings for variable assigned but not read .m*+ turn on warnings for suspicious modulus value .M turn off warnings for suspicious modulus value n* normal warning mode (cancels -gnatws/-gnatwe) .n turn on info messages for atomic synchronization .N* turn off info messages for atomic synchronization o* turn on warnings for address clause overlay O turn off warnings for address clause overlay .o turn on warnings for out parameters assigned but not read .O* turn off warnings for out parameters assigned but not read p+ turn on warnings for ineffective pragma Inline in frontend P* turn off warnings for ineffective pragma Inline in frontend .p+ turn on warnings for suspicious parameter order .P* turn off warnings for suspicious parameter order q*+ turn on warnings for questionable missing parenthesis Q turn off warnings for questionable missing parenthesis .q+ turn on warnings for questionable layout of record types .Q* turn off warnings for questionable layout of record types r+ turn on warnings for redundant construct R* turn off warnings for redundant construct .r+ turn on warnings for object renaming function .R* turn off warnings for object renaming function s suppress all info/warnings .s turn on warnings for overridden size clause .S* turn off warnings for overridden size clause t turn on warnings for tracking deleted code T* turn off warnings for tracking deleted code .t*+ turn on warnings for suspicious contract .T turn off warnings for suspicious contract u+ turn on warnings for unused entity U* turn off warnings for unused entity .u turn on warnings for unordered enumeration .U* turn off warnings for unordered enumeration v*+ turn on warnings for unassigned variable V turn off warnings for unassigned variable .v*+ turn on info messages for reverse bit order .V turn off info messages for reverse bit order w*+ turn on warnings for wrong low bound assumption W turn off warnings for wrong low bound assumption .w turn on warnings on pragma Warnings Off .W* turn off warnings on pragma Warnings Off x*+ turn on warnings for export/import X turn off warnings for export/import .x+ turn on warnings for non-local exception .X* turn off warnings for non-local exception y*+ turn on warnings for Ada compatibility issues Y turn off warnings for Ada compatibility issues .y turn on info messages for why pkg body needed .Y* turn off info messages for why pkg body needed z*+ turn on warnings for suspicious unchecked conversion Z turn off warnings for suspicious unchecked conversion .z*+ turn on warnings for record size not a multiple of alignment .Z turn off warnings for record size not a multiple of alignment -gnatW? Wide character encoding method (?=h/u/s/e/8/b) -gnatx Suppress output of cross-reference information -gnatX Language extensions permitted -gnaty Enable default style checks (same as -gnaty3abcefhiklmnprst) -gnatyxx Enable selected style checks xx = list of parameters: 1-9 check indentation a check attribute casing A check array attribute indexes b check no blanks at end of lines B check no use of AND/OR for boolean expressions c check comment format (two spaces) C check comment format (one space) d check no DOS line terminators e check end/exit labels present f check no form feeds/vertical tabs in source g check standard GNAT style rules, same as ydISux h check no horizontal tabs in source i check if-then layout I check mode in k check casing rules for keywords l check reference manual layout Lnn check max nest level < nn m check line length <= 79 characters Mnn check line length <= nn characters n check casing of package Standard identifiers N turn off all checks o check subprogram bodies in alphabetical order O check overriding indicators p check pragma casing r check casing for identifier references s check separate subprogram specs present S check separate lines after THEN or ELSE t check token separation rules u check no unnecessary blank lines x check extra parentheses around conditionals y turn on default style checks - subtract (turn off) subsequent checks + add (turn on) subsequent checks -gnatyN Cancel all previously set style checks -gnatzc Distribution stub generation for caller stubs -gnatzr Distribution stub generation for receiver stubs -gnat83 Ada 83 mode -gnat95 Ada 95 mode -gnat2005 Ada 2005 mode -gnat2012 Ada 2012 mode (default) -gnat-p Cancel effect of previous -gnatp switch 2019-08-13 Justin Squirek gcc/ada/ * gnatcmd.adb (GNATCmd): Add constant for new compiler switch --help-ada, and include usage subprogram. Add line to usage help explaining the new flag. (GNATCmd_Usage): Rename from locally declared Usage so as not to confuse with the newly imported version. Add new argument case for --help-ada and add bug report email to implicit display of help without the --help flag so as to unify output between the two cases. From-SVN: r274334 --- gcc/ada/ChangeLog | 11 +++++++++++ gcc/ada/gnatcmd.adb | 36 +++++++++++++++++++++++++++--------- 2 files changed, 38 insertions(+), 9 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index eab24a0..1cc1ef2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2019-08-13 Justin Squirek + + * gnatcmd.adb (GNATCmd): Add constant for new compiler switch + --help-ada, and include usage subprogram. Add line to usage help + explaining the new flag. + (GNATCmd_Usage): Rename from locally declared Usage so as not to + confuse with the newly imported version. Add new argument case + for --help-ada and add bug report email to implicit display of + help without the --help flag so as to unify output between the + two cases. + 2019-08-13 Dmitriy Anisimkov * libgnat/g-comlin.adb (Getopt): Quote unrecognized switch in diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 271e899..f83b0f2 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -30,6 +30,7 @@ with Osint; use Osint; with Output; use Output; with Switch; use Switch; with Table; +with Usage; with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Command_Line; use Ada.Command_Line; @@ -43,6 +44,9 @@ procedure GNATCmd is Gprname : constant String := "gprname"; Gprls : constant String := "gprls"; + Ada_Help_Switch : constant String := "--help-ada"; + -- Flag to display available build switches + Error_Exit : exception; -- Raise this exception if error detected @@ -229,7 +233,7 @@ procedure GNATCmd is procedure Output_Version; -- Output the version of this program - procedure Usage; + procedure GNATCmd_Usage; -- Display usage -------------------- @@ -244,14 +248,16 @@ procedure GNATCmd is & ", Free Software Foundation, Inc."); end Output_Version; - ----------- - -- Usage -- - ----------- + ------------------- + -- GNATCmd_Usage -- + ------------------- - procedure Usage is + procedure GNATCmd_Usage is begin Output_Version; New_Line; + Put_Line ("To list Ada build switches use " & Ada_Help_Switch); + New_Line; Put_Line ("List of available commands"); New_Line; @@ -276,9 +282,10 @@ procedure GNATCmd is end loop; New_Line; - end Usage; + end GNATCmd_Usage; - procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage); + procedure Check_Version_And_Help + is new Check_Version_And_Help_G (GNATCmd_Usage); -- Start of processing for GNATCmd @@ -351,6 +358,12 @@ begin Keep_Temporary_Files := True; Command_Arg := Command_Arg + 1; + elsif Command_Arg <= Argument_Count + and then Argument (Command_Arg) = Ada_Help_Switch + then + Usage; + Exit_Program (E_Success); + else exit; end if; @@ -359,7 +372,12 @@ begin -- If there is no command, just output the usage if Command_Arg > Argument_Count then - Usage; + GNATCmd_Usage; + + -- Add the following so that output is consistent with or without the + -- --help flag. + Write_Eol; + Write_Line ("Report bugs to report@adacore.com"); return; end if; @@ -379,7 +397,7 @@ begin exception when Constraint_Error => - Usage; + GNATCmd_Usage; Fail ("unknown command: " & Argument (Command_Arg)); end; end; -- cgit v1.1 From 7225a4797180b6dc515760b0c123001cda2b66a2 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Tue, 13 Aug 2019 08:06:34 +0000 Subject: [Ada] Wrong initialization of Offset_To_Top in secondary DT The compiler does not initialize well the runtime information required to perform at runtime interface conversions on derivations of tagged types that implement interfaces and have variable size components. 2019-08-13 Javier Miranda gcc/ada/ * exp_disp.adb (Make_Secondary_DT): Handle record type derivations that have interface components located at fixed positions and interface components located at variable offset. The offset of components located at fixed positions is computed using the dummy object (similar to the case where all the interface components are located at fixed positions). (Make_DT): Build the dummy object for all tagged types that implement interface types (that is, build it also for types with variable size components), and use the dummy object to compute the offset of all tag components located at fixed positions when initializing the Interface_Table object. gcc/testsuite/ * gnat.dg/tag2.adb, gnat.dg/tag2_pkg.ads: New testcase. From-SVN: r274335 --- gcc/ada/ChangeLog | 14 ++++++++++ gcc/ada/exp_disp.adb | 79 +++++++++++++++++++++++++++++++--------------------- 2 files changed, 62 insertions(+), 31 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1cc1ef2..0c34ee8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2019-08-13 Javier Miranda + + * exp_disp.adb (Make_Secondary_DT): Handle record type + derivations that have interface components located at fixed + positions and interface components located at variable offset. + The offset of components located at fixed positions is computed + using the dummy object (similar to the case where all the + interface components are located at fixed positions). + (Make_DT): Build the dummy object for all tagged types that + implement interface types (that is, build it also for types with + variable size components), and use the dummy object to compute + the offset of all tag components located at fixed positions when + initializing the Interface_Table object. + 2019-08-13 Justin Squirek * gnatcmd.adb (GNATCmd): Add constant for new compiler switch diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 4fae37c..8399c4c 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -3764,7 +3764,7 @@ package body Exp_Disp is Dummy_Object : Entity_Id := Empty; -- Extra nonexistent object of type Typ internally used to compute the -- offset to the components that reference secondary dispatch tables. - -- Used to statically allocate secondary dispatch tables. + -- Used to compute the offset of components located at fixed position. procedure Check_Premature_Freezing (Subp : Entity_Id; @@ -4191,14 +4191,16 @@ package body Exp_Disp is Prefix => New_Occurrence_Of (Predef_Prims, Loc), Attribute_Name => Name_Address)); - -- If the location of the component that references this secondary - -- dispatch table is variable then we have not declared the internal - -- dummy object; the value of Offset_To_Top will be set by the init - -- subprogram. + -- Interface component located at variable offset; the value of + -- Offset_To_Top will be set by the init subprogram. - if No (Dummy_Object) then + if No (Dummy_Object) + or else Is_Variable_Size_Record (Etype (Scope (Iface_Comp))) + then Append_To (DT_Aggr_List, Make_Integer_Literal (Loc, 0)); + -- Interface component located at fixed offset + else Append_To (DT_Aggr_List, Make_Op_Minus (Loc, @@ -4444,7 +4446,7 @@ package body Exp_Disp is Make_Object_Declaration (Loc, Defining_Identifier => Iface_DT, Aliased_Present => True, - Constant_Present => Present (Dummy_Object), + Constant_Present => Building_Static_Secondary_DT (Typ), Object_Definition => Make_Subtype_Indication (Loc, @@ -4723,9 +4725,10 @@ package body Exp_Disp is end; end if; - if Building_Static_Secondary_DT (Typ) then + if not Is_Interface (Typ) and then Has_Interfaces (Typ) then declare Cannot_Have_Null_Disc : Boolean := False; + Dummy_Object_Typ : constant Entity_Id := Typ; Name_Dummy_Object : constant Name_Id := New_External_Name (Tname, 'P', Suffix_Index => -1); @@ -4754,19 +4757,20 @@ package body Exp_Disp is Set_Is_Internal (Dummy_Object); - if not Has_Discriminants (Typ) then + if not Has_Discriminants (Dummy_Object_Typ) then Append_To (Result, Make_Object_Declaration (Loc, Defining_Identifier => Dummy_Object, Constant_Present => True, - Object_Definition => New_Occurrence_Of (Typ, Loc))); + Object_Definition => New_Occurrence_Of + (Dummy_Object_Typ, Loc))); else declare Constr_List : constant List_Id := New_List; Discrim : Node_Id; begin - Discrim := First_Discriminant (Typ); + Discrim := First_Discriminant (Dummy_Object_Typ); while Present (Discrim) loop if Is_Discrete_Type (Etype (Discrim)) then Append_To (Constr_List, @@ -4792,7 +4796,8 @@ package body Exp_Disp is Constant_Present => True, Object_Definition => Make_Subtype_Indication (Loc, - Subtype_Mark => New_Occurrence_Of (Typ, Loc), + Subtype_Mark => + New_Occurrence_Of (Dummy_Object_Typ, Loc), Constraint => Make_Index_Or_Discriminant_Constraint (Loc, Constraints => Constr_List)))); @@ -5500,19 +5505,23 @@ package body Exp_Disp is declare TSD_Ifaces_List : constant List_Id := New_List; Elmt : Elmt_Id; - Ifaces_List : Elist_Id := No_Elist; - Ifaces_Comp_List : Elist_Id := No_Elist; - Ifaces_Tag_List : Elist_Id; Offset_To_Top : Node_Id; Sec_DT_Tag : Node_Id; + Dummy_Object_Ifaces_List : Elist_Id := No_Elist; + Dummy_Object_Ifaces_Comp_List : Elist_Id := No_Elist; + Dummy_Object_Ifaces_Tag_List : Elist_Id := No_Elist; + -- Interfaces information of the dummy object + begin -- Collect interfaces information if we need to compute the -- offset to the top using the dummy object. if Present (Dummy_Object) then Collect_Interfaces_Info (Typ, - Ifaces_List, Ifaces_Comp_List, Ifaces_Tag_List); + Ifaces_List => Dummy_Object_Ifaces_List, + Components_List => Dummy_Object_Ifaces_Comp_List, + Tags_List => Dummy_Object_Ifaces_Tag_List); end if; AI := First_Elmt (Typ_Ifaces); @@ -5550,8 +5559,8 @@ package body Exp_Disp is (Node (Next_Elmt (Next_Elmt (Elmt))), Loc); end if; - -- For static dispatch tables compute Offset_To_Top using - -- the dummy object. + -- Use the dummy object to compute Offset_To_Top of + -- components located at fixed position. if Present (Dummy_Object) then declare @@ -5561,8 +5570,10 @@ package body Exp_Disp is Iface_Elmt : Elmt_Id; begin - Iface_Elmt := First_Elmt (Ifaces_List); - Iface_Comp_Elmt := First_Elmt (Ifaces_Comp_List); + Iface_Elmt := + First_Elmt (Dummy_Object_Ifaces_List); + Iface_Comp_Elmt := + First_Elmt (Dummy_Object_Ifaces_Comp_List); while Present (Iface_Elmt) loop if Node (Iface_Elmt) = Iface then @@ -5576,16 +5587,22 @@ package body Exp_Disp is pragma Assert (Present (Iface_Comp)); - Offset_To_Top := - Make_Op_Minus (Loc, - Make_Attribute_Reference (Loc, - Prefix => - Make_Selected_Component (Loc, - Prefix => - New_Occurrence_Of (Dummy_Object, Loc), - Selector_Name => - New_Occurrence_Of (Iface_Comp, Loc)), - Attribute_Name => Name_Position)); + if not + Is_Variable_Size_Record (Etype (Scope (Iface_Comp))) + then + Offset_To_Top := + Make_Op_Minus (Loc, + Make_Attribute_Reference (Loc, + Prefix => + Make_Selected_Component (Loc, + Prefix => + New_Occurrence_Of (Dummy_Object, Loc), + Selector_Name => + New_Occurrence_Of (Iface_Comp, Loc)), + Attribute_Name => Name_Position)); + else + Offset_To_Top := Make_Integer_Literal (Loc, 0); + end if; end; else Offset_To_Top := Make_Integer_Literal (Loc, 0); @@ -5634,7 +5651,7 @@ package body Exp_Disp is Make_Object_Declaration (Loc, Defining_Identifier => ITable, Aliased_Present => True, - Constant_Present => Present (Dummy_Object), + Constant_Present => Building_Static_Secondary_DT (Typ), Object_Definition => Make_Subtype_Indication (Loc, Subtype_Mark => -- cgit v1.1 From d71e9fb2a5f1d55a065e3b50ee5fb2a34e75ead7 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 13 Aug 2019 08:06:39 +0000 Subject: [Ada] Fix spurious error on nested instantiation with inlining This prevents the compiler from issuing a spurious error in a convoluted case where a child generic package declared in an enclosing parent generic package, which contains a second child generic package, contains an inlined subprogram and the second child generic package contains an instantiation of the first, and the enclosing parent generic package is instantiated with inlining across units enabled (-gnatn[12]). The problem is that the compiler attempts to instantiate the body of the first child generic package in the context of the enclosing parent generic package, instead of doing it in the context of the instantiation of the parent generic package, because of the presence of the inlined subprogram. 2019-08-13 Eric Botcazou gcc/ada/ * exp_ch6.adb (Expand_Call_Helper): If back-end inlining is enabled, also instantiate the body of a generic unit containing a subprogram subject to aspect/pragma Inline_Always at optimization level zero. * sem_ch12.adb (Might_Inline_Subp): Minor tweak. (Analyze_Package_Instantiation): Do not instantiate the package body because of inlining considerations if the instantiation is done in a generic unit. Move around similar condition involving the main unit. Add test on Back_End_Inlining to processing for front-end inlining. gcc/testsuite/ * gnat.dg/generic_inst8.adb, gnat.dg/generic_inst8.ads, gnat.dg/generic_inst8_g.adb, gnat.dg/generic_inst8_g.ads: New testcase. From-SVN: r274336 --- gcc/ada/ChangeLog | 13 +++++++++++++ gcc/ada/exp_ch6.adb | 11 ++++++----- gcc/ada/sem_ch12.adb | 31 +++++++++++++++---------------- 3 files changed, 34 insertions(+), 21 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0c34ee8..2b0f272 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2019-08-13 Eric Botcazou + + * exp_ch6.adb (Expand_Call_Helper): If back-end inlining is + enabled, also instantiate the body of a generic unit containing + a subprogram subject to aspect/pragma Inline_Always at + optimization level zero. + * sem_ch12.adb (Might_Inline_Subp): Minor tweak. + (Analyze_Package_Instantiation): Do not instantiate the package + body because of inlining considerations if the instantiation is + done in a generic unit. Move around similar condition involving + the main unit. Add test on Back_End_Inlining to processing for + front-end inlining. + 2019-08-13 Javier Miranda * exp_disp.adb (Make_Secondary_DT): Handle record type diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 8d5a70db..4fd3860 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -4431,14 +4431,15 @@ package body Exp_Ch6 is then Add_Inlined_Body (Subp, Call_Node); - -- If the inlined call appears within an instantiation and some - -- level of optimization is required, ensure that the enclosing - -- instance body is available so that the back-end can actually - -- perform the inlining. + -- If the inlined call appears within an instantiation and either + -- is required to be inlined or optimization is enabled, ensure + -- that the enclosing instance body is available so the back end + -- can actually perform the inlining. if In_Instance and then Comes_From_Source (Subp) - and then Optimization_Level > 0 + and then (Has_Pragma_Inline_Always (Subp) + or else Optimization_Level > 0) then declare Decl : Node_Id; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 1f3a397..8b031b5 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3895,10 +3895,7 @@ package body Sem_Ch12 is E : Entity_Id; begin - if not Inline_Processing_Required then - return False; - - else + if Inline_Processing_Required then E := First_Entity (Gen_Unit); while Present (E) loop if Is_Subprogram (E) and then Is_Inlined (E) then @@ -4281,12 +4278,13 @@ package body Sem_Ch12 is end if; end if; - -- Save the instantiation node, for subsequent instantiation of the - -- body, if there is one and we are generating code for the current - -- unit. Mark unit as having a body (avoids premature error message). + -- Save the instantiation node for a subsequent instantiation of the + -- body if there is one and the main unit is not generic, and either + -- we are generating code for this main unit, or the instantiation + -- contains inlined subprograms and is not done in a generic unit. - -- We instantiate the body if we are generating code, if we are - -- generating cross-reference information, or if we are building + -- We instantiate the body only if we are generating code, or if we + -- are generating cross-reference information, or if we are building -- trees for ASIS use or GNATprove use. declare @@ -4379,14 +4377,15 @@ package body Sem_Ch12 is (Unit_Requires_Body (Gen_Unit) or else Enclosing_Body_Present or else Present (Corresponding_Body (Gen_Decl))) + and then not Is_Generic_Unit (Cunit_Entity (Main_Unit)) and then (Is_In_Main_Unit (N) - or else Might_Inline_Subp (Gen_Unit)) + or else (Might_Inline_Subp (Gen_Unit) + and then + not Is_Generic_Unit + (Cunit_Entity (Get_Code_Unit (N))))) and then not Is_Actual_Pack and then not Inline_Now and then (Operating_Mode = Generate_Code - - -- Need comment for this check ??? - or else (Operating_Mode = Check_Semantics and then (ASIS_Mode or GNATprove_Mode))); @@ -4394,9 +4393,9 @@ package body Sem_Ch12 is -- marked with Inline_Always, do not instantiate body when within -- a generic context. - if ((Front_End_Inlining or else Has_Inline_Always) - and then not Expander_Active) - or else Is_Generic_Unit (Cunit_Entity (Main_Unit)) + if not Back_End_Inlining + and then (Front_End_Inlining or else Has_Inline_Always) + and then not Expander_Active then Needs_Body := False; end if; -- cgit v1.1 From 114042b8861a33ec7227c5ac2967058ee60c248f Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 13 Aug 2019 08:06:44 +0000 Subject: [Ada] Add/fix documentation for the Double_*_Alignment parameters 2019-08-13 Eric Botcazou gcc/ada/ * doc/gnat_ugn/building_executable_programs_with_gnat.rst (-gnateT): Document Double_Float_Alignment parameter and fix description of Double_Scalar_Alignment parameter. * gnat_ugn.texi: Regenerate. From-SVN: r274337 --- gcc/ada/ChangeLog | 7 +++++++ .../doc/gnat_ugn/building_executable_programs_with_gnat.rst | 10 ++++++---- gcc/ada/gnat_ugn.texi | 12 +++++++----- 3 files changed, 20 insertions(+), 9 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2b0f272..f4ad36d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,12 @@ 2019-08-13 Eric Botcazou + * doc/gnat_ugn/building_executable_programs_with_gnat.rst + (-gnateT): Document Double_Float_Alignment parameter and fix + description of Double_Scalar_Alignment parameter. + * gnat_ugn.texi: Regenerate. + +2019-08-13 Eric Botcazou + * exp_ch6.adb (Expand_Call_Helper): If back-end inlining is enabled, also instantiate the body of a generic unit containing a subprogram subject to aspect/pragma Inline_Always at diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst index 2e867e2..beceb51 100644 --- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst +++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst @@ -1714,11 +1714,13 @@ Alphabetical List of All Switches GCC macro ``BITS_PER_WORD`` documented as follows: `Number of bits in a word; normally 32.` - ``Double_Scalar_Alignment`` is the alignment for a scalar whose size is two - machine words. It should be the same as the alignment for C ``long_long`` on - most targets. + ``Double_Float_Alignment``, if not zero, is the maximum alignment that the + compiler can choose by default for a 64-bit floating-point type or object. - ``Maximum_Alignment`` is the maximum alignment that the compiler might choose + ``Double_Scalar_Alignment``, if not zero, is the maximum alignment that the + compiler can choose by default for a 64-bit or larger scalar type or object. + + ``Maximum_Alignment`` is the maximum alignment that the compiler can choose by default for a type or object, which is also the maximum alignment that can be specified in GNAT. It is computed for GCC backends as ``BIGGEST_ALIGNMENT / BITS_PER_UNIT`` where GCC macro ``BIGGEST_ALIGNMENT`` is documented as diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index e3d6a3a..5f73ab7 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -21,7 +21,7 @@ @copying @quotation -GNAT User's Guide for Native Platforms , Jun 21, 2019 +GNAT User's Guide for Native Platforms , Jul 31, 2019 AdaCore @@ -9452,11 +9452,13 @@ GCC macro @code{BITS_PER_UNIT} documented as follows: @cite{Define this macro to @code{Bits_Per_Word} is the number of bits in a machine word, the equivalent of GCC macro @code{BITS_PER_WORD} documented as follows: @cite{Number of bits in a word; normally 32.} -@code{Double_Scalar_Alignment} is the alignment for a scalar whose size is two -machine words. It should be the same as the alignment for C @code{long_long} on -most targets. +@code{Double_Float_Alignment}, if not zero, is the maximum alignment that the +compiler can choose by default for a 64-bit floating-point type or object. -@code{Maximum_Alignment} is the maximum alignment that the compiler might choose +@code{Double_Scalar_Alignment}, if not zero, is the maximum alignment that the +compiler can choose by default for a 64-bit or larger scalar type or object. + +@code{Maximum_Alignment} is the maximum alignment that the compiler can choose by default for a type or object, which is also the maximum alignment that can be specified in GNAT. It is computed for GCC backends as @code{BIGGEST_ALIGNMENT / BITS_PER_UNIT} where GCC macro @code{BIGGEST_ALIGNMENT} is documented as -- cgit v1.1 From 943c82d7b9bc15161ac344953b2deb0a4121b279 Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Tue, 13 Aug 2019 08:06:50 +0000 Subject: [Ada] Disable anonymous allocator warning for library-level objects This patch modifies the behavior of anonymous allocator warnings so that they no longer get triggered in the case of an object declaration at library-level. 2019-08-13 Justin Squirek gcc/ada/ * exp_ch4.adb (Expand_N_Allocator): Add condition to detect library-level object declarations gcc/testsuite/ * gnat.dg/anon3.adb, gnat.dg/anon3.ads: New testcase. From-SVN: r274338 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/exp_ch4.adb | 5 ++++- 2 files changed, 9 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f4ad36d..5a9a9cc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-13 Justin Squirek + + * exp_ch4.adb (Expand_N_Allocator): Add condition to detect + library-level object declarations + 2019-08-13 Eric Botcazou * doc/gnat_ugn/building_executable_programs_with_gnat.rst diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 6f2fe32..4404c5d 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -4421,10 +4421,13 @@ package body Exp_Ch4 is begin -- Warn on the presence of an allocator of an anonymous access type when - -- enabled. + -- enabled except when its an object declaration at library level. if Warn_On_Anonymous_Allocators and then Ekind (PtrT) = E_Anonymous_Access_Type + and then not (Is_Library_Level_Entity (PtrT) + and then Nkind (Associated_Node_For_Itype (PtrT)) = + N_Object_Declaration) then Error_Msg_N ("?use of an anonymous access type allocator", N); end if; -- cgit v1.1 From fa0c3ab8c54e8cba46c26c3d29f3e7be435e126a Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Tue, 13 Aug 2019 08:06:55 +0000 Subject: [Ada] Avoid spurious errors on dimensionality checking in GNATprove Complete the partial treatment that was started in r273405. Instead of checking for the special case of nodes inside inlined bodies at the call site, check for this condition inside the top-level procedures called for dimensionality checking. There is no impact on compilation. 2019-08-13 Yannick Moy gcc/ada/ * sem_dim.adb (Analyze_Dimension, Analyze_Dimension_Array_Aggregate, Analyze_Dimension_Call, Analyze_Dimension_Extension_Or_Record_Aggregate): Return immediately when inside an inlined body. * sem_res.adb (Resolve_Call): Remove special checking now done inside Analyze_Dimension_Call. From-SVN: r274339 --- gcc/ada/ChangeLog | 9 +++++++++ gcc/ada/sem_dim.adb | 20 +++++++++++++++----- gcc/ada/sem_res.adb | 4 +--- 3 files changed, 25 insertions(+), 8 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5a9a9cc..9ae91db 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2019-08-13 Yannick Moy + + * sem_dim.adb (Analyze_Dimension, + Analyze_Dimension_Array_Aggregate, Analyze_Dimension_Call, + Analyze_Dimension_Extension_Or_Record_Aggregate): Return + immediately when inside an inlined body. + * sem_res.adb (Resolve_Call): Remove special checking now done + inside Analyze_Dimension_Call. + 2019-08-13 Justin Squirek * exp_ch4.adb (Expand_N_Allocator): Add condition to detect diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb index 2bcccd2..177902f 100644 --- a/gcc/ada/sem_dim.adb +++ b/gcc/ada/sem_dim.adb @@ -1142,6 +1142,11 @@ package body Sem_Dim is if Ada_Version < Ada_2012 then return; + -- Inlined bodies have already been checked for dimensionality + + elsif In_Inlined_Body then + return; + elsif not Comes_From_Source (N) then if Nkind_In (N, N_Explicit_Dereference, N_Identifier, @@ -1245,10 +1250,13 @@ package body Sem_Dim is -- Aspect is an Ada 2012 feature. Nothing to do here if the component -- base type is not a dimensioned type. + -- Inlined bodies have already been checked for dimensionality. + -- Note that here the original node must come from source since the -- original array aggregate may not have been entirely decorated. if Ada_Version < Ada_2012 + or else In_Inlined_Body or else not Comes_From_Source (Original_Node (N)) or else not Has_Dimension_System (Base_Type (Comp_Typ)) then @@ -1634,10 +1642,11 @@ package body Sem_Dim is begin -- Aspect is an Ada 2012 feature. Note that there is no need to check - -- dimensions for calls that don't come from source, or those that may - -- have semantic errors. + -- dimensions for calls in inlined bodies, or calls that don't come + -- from source, or those that may have semantic errors. if Ada_Version < Ada_2012 + or else In_Inlined_Body or else not Comes_From_Source (N) or else Error_Posted (N) then @@ -1966,11 +1975,12 @@ package body Sem_Dim is begin -- Aspect is an Ada 2012 feature. Note that there is no need to check - -- dimensions for aggregates that don't come from source, or if we are - -- within an initialization procedure, whose expressions have been - -- checked at the point of record declaration. + -- dimensions in inlined bodies, or for aggregates that don't come + -- from source, or if we are within an initialization procedure, whose + -- expressions have been checked at the point of record declaration. if Ada_Version < Ada_2012 + or else In_Inlined_Body or else not Comes_From_Source (N) or else Inside_Init_Proc then diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index ecd8bc0..759887c 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -6952,9 +6952,7 @@ package body Sem_Res is -- Check the dimensions of the actuals in the call. For function calls, -- propagate the dimensions from the returned type to N. - if not In_Inlined_Body then - Analyze_Dimension_Call (N, Nam); - end if; + Analyze_Dimension_Call (N, Nam); -- All done, evaluate call and deal with elaboration issues -- cgit v1.1 From 07c6ed01a7822229280329fd99587a35dc2acc83 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 13 Aug 2019 08:07:03 +0000 Subject: [Ada] Systematically pass LN_S to relevant gnatlib targets 2019-08-13 Arnaud Charlet gcc/ada/ * gcc-interface/Make-lang.in: Remove unused TRACE variable. Pass LN_S to relevant gnatlib targets. * gcc-interface/Makefile.in: Systematically pass LN_S to relevant gnatlib targets. From-SVN: r274340 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/gcc-interface/Make-lang.in | 3 +-- gcc/ada/gcc-interface/Makefile.in | 25 ++++++++++++++++++------- 3 files changed, 26 insertions(+), 9 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9ae91db..a67cc5d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-08-13 Arnaud Charlet + + * gcc-interface/Make-lang.in: Remove unused TRACE variable. Pass + LN_S to relevant gnatlib targets. + * gcc-interface/Makefile.in: Systematically pass LN_S to + relevant gnatlib targets. + 2019-08-13 Yannick Moy * sem_dim.adb (Analyze_Dimension, diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index b6a337a..df5f0b3 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -74,7 +74,6 @@ GNATLIBCFLAGS= -g -O2 $(TCFLAGS) ADA_INCLUDE_DIR = $(libsubdir)/adainclude ADA_RTL_OBJ_DIR = $(libsubdir)/adalib THREAD_KIND=native -TRACE=no # We do not want the WARN_CFLAGS of the compiler in Ada as it is for C/C++. COMMON_FLAGS_TO_PASS = $(filter-out $(WARN_CFLAGS), $(FLAGS_TO_PASS)) ADA_FLAGS_TO_PASS = \ @@ -701,7 +700,7 @@ gnatlib gnatlib-sjlj gnatlib-zcx gnatlib-shared: force GNATLIBCFLAGS="$(GNATLIBCFLAGS)" \ TARGET_LIBGCC2_CFLAGS="$(TARGET_LIBGCC2_CFLAGS)" \ THREAD_KIND="$(THREAD_KIND)" \ - TRACE="$(TRACE)" \ + LN_S="$(LN_S)" \ FORCE_DEBUG_ADAFLAGS="$(FORCE_DEBUG_ADAFLAGS)" \ $@ diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index a0a5bb2..e9a4874 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -563,7 +563,7 @@ install-gnatlib: ../stamp-gnatlib-$(RTSDIR) install-gcc-specs $(RM) ../stamp-gnatlib-$(RTSDIR) ../stamp-gnatlib1-$(RTSDIR): Makefile ../stamp-gnatlib2-$(RTSDIR) - $(MAKE) MULTISUBDIR="$(MULTISUBDIR)" THREAD_KIND="$(THREAD_KIND)" setup-rts + $(MAKE) MULTISUBDIR="$(MULTISUBDIR)" THREAD_KIND="$(THREAD_KIND)" LN_S="$(LN_S)" setup-rts # Copy tsystem.h $(CP) $(srcdir)/tsystem.h $(RTSDIR) $(RM) ../stamp-gnatlib-$(RTSDIR) @@ -651,6 +651,7 @@ gnatlib-shared-default: GNATLIBCFLAGS_FOR_C="$(GNATLIBCFLAGS_FOR_C) $(PICFLAG_FOR_TARGET)" \ MULTISUBDIR="$(MULTISUBDIR)" \ THREAD_KIND="$(THREAD_KIND)" \ + LN_S="$(LN_S)" \ gnatlib $(RM) $(RTSDIR)/libgna*$(soext) cd $(RTSDIR); `echo "$(GCC_FOR_TARGET)" \ @@ -681,7 +682,6 @@ gnatlib-shared-default: $(addprefix $(RTSDIR)/,$(GNATRTL_TASKING_OBJS)) $(RANLIB_FOR_TARGET) $(RTSDIR)/libgnarl_pic$(arext) - gnatlib-shared-dual: $(MAKE) $(FLAGS_TO_PASS) \ GNATLIBFLAGS="$(GNATLIBFLAGS)" \ @@ -690,6 +690,7 @@ gnatlib-shared-dual: PICFLAG_FOR_TARGET="$(PICFLAG_FOR_TARGET)" \ MULTISUBDIR="$(MULTISUBDIR)" \ THREAD_KIND="$(THREAD_KIND)" \ + LN_S="$(LN_S)" \ gnatlib-shared-default $(MV) $(RTSDIR)/libgna*$(soext) . $(MV) $(RTSDIR)/libgnat_pic$(arext) . @@ -701,7 +702,8 @@ gnatlib-shared-dual: GNATLIBCFLAGS_FOR_C="$(GNATLIBCFLAGS_FOR_C)" \ MULTISUBDIR="$(MULTISUBDIR)" \ THREAD_KIND="$(THREAD_KIND)" \ - gnatlib + LN_S="$(LN_S)" \ + gnatlib $(MV) libgna*$(soext) $(RTSDIR) $(MV) libgnat_pic$(arext) $(RTSDIR) $(MV) libgnarl_pic$(arext) $(RTSDIR) @@ -714,7 +716,8 @@ gnatlib-shared-dual-win32: PICFLAG_FOR_TARGET="$(PICFLAG_FOR_TARGET)" \ MULTISUBDIR="$(MULTISUBDIR)" \ THREAD_KIND="$(THREAD_KIND)" \ - gnatlib-shared-win32 + LN_S="$(LN_S)" \ + gnatlib-shared-win32 $(MV) $(RTSDIR)/libgna*$(soext) . $(RM) ../stamp-gnatlib2-$(RTSDIR) $(MAKE) $(FLAGS_TO_PASS) \ @@ -723,7 +726,8 @@ gnatlib-shared-dual-win32: GNATLIBCFLAGS_FOR_C="$(GNATLIBCFLAGS_FOR_C)" \ MULTISUBDIR="$(MULTISUBDIR)" \ THREAD_KIND="$(THREAD_KIND)" \ - gnatlib + LN_S="$(LN_S)" \ + gnatlib $(MV) libgna*$(soext) $(RTSDIR) # ??? we need to add the option to support auto-import of arrays/records to @@ -737,7 +741,8 @@ gnatlib-shared-win32: GNATLIBCFLAGS_FOR_C="$(GNATLIBCFLAGS_FOR_C) $(PICFLAG_FOR_TARGET)" \ MULTISUBDIR="$(MULTISUBDIR)" \ THREAD_KIND="$(THREAD_KIND)" \ - gnatlib + LN_S="$(LN_S)" \ + gnatlib $(RM) $(RTSDIR)/libgna*$(soext) $(CP) $(RTSDIR)/libgnat$(arext) $(RTSDIR)/libgnat_pic$(arext) $(CP) $(RTSDIR)/libgnarl$(arext) $(RTSDIR)/libgnarl_pic$(arext) @@ -762,6 +767,7 @@ gnatlib-shared-darwin: GNATLIBCFLAGS_FOR_C="$(GNATLIBCFLAGS_FOR_C) $(PICFLAG_FOR_TARGET) -fno-common" \ MULTISUBDIR="$(MULTISUBDIR)" \ THREAD_KIND="$(THREAD_KIND)" \ + LN_S="$(LN_S)" \ gnatlib $(RM) $(RTSDIR)/libgnat$(soext) $(RTSDIR)/libgnarl$(soext) $(CP) $(RTSDIR)/libgnat$(arext) $(RTSDIR)/libgnat_pic$(arext) @@ -794,8 +800,9 @@ gnatlib-shared: GNATLIBCFLAGS_FOR_C="$(GNATLIBCFLAGS_FOR_C)" \ MULTISUBDIR="$(MULTISUBDIR)" \ THREAD_KIND="$(THREAD_KIND)" \ + LN_S="$(LN_S)" \ PICFLAG_FOR_TARGET="$(PICFLAG_FOR_TARGET)" \ - $(GNATLIB_SHARED) + $(GNATLIB_SHARED) # When building a SJLJ runtime for VxWorks, we need to ensure that the extra # linker options needed for ZCX are not passed to prevent the inclusion of @@ -808,6 +815,7 @@ gnatlib-sjlj: EH_MECHANISM="" \ MULTISUBDIR="$(MULTISUBDIR)" \ THREAD_KIND="$(THREAD_KIND)" \ + LN_S="$(LN_S)" \ ../stamp-gnatlib1-$(RTSDIR) sed \ -e 's/Frontend_Exceptions.*/Frontend_Exceptions : constant Boolean := True;/' \ @@ -822,6 +830,7 @@ gnatlib-sjlj: FORCE_DEBUG_ADAFLAGS="$(FORCE_DEBUG_ADAFLAGS)" \ MULTISUBDIR="$(MULTISUBDIR)" \ THREAD_KIND="$(THREAD_KIND)" \ + LN_S="$(LN_S)" \ gnatlib gnatlib-zcx: @@ -829,6 +838,7 @@ gnatlib-zcx: EH_MECHANISM="-gcc" \ MULTISUBDIR="$(MULTISUBDIR)" \ THREAD_KIND="$(THREAD_KIND)" \ + LN_S="$(LN_S)" \ ../stamp-gnatlib1-$(RTSDIR) sed \ -e 's/Frontend_Exceptions.*/Frontend_Exceptions : constant Boolean := False;/' \ @@ -843,6 +853,7 @@ gnatlib-zcx: FORCE_DEBUG_ADAFLAGS="$(FORCE_DEBUG_ADAFLAGS)" \ MULTISUBDIR="$(MULTISUBDIR)" \ THREAD_KIND="$(THREAD_KIND)" \ + LN_S="$(LN_S)" \ gnatlib # Compiling object files from source files. -- cgit v1.1 From 3fee1dcfc7df9b393c019f289b6a28f7ad7f8f8c Mon Sep 17 00:00:00 2001 From: Olivier Hainque Date: Tue, 13 Aug 2019 08:07:08 +0000 Subject: [Ada] Fix incorrect binding to MapViewOfFile in s-win32.ads Despite the "dw" prefix on the name, the dwNumberOfBytesToMap argument to MapViewOfFile was changed from DWORD to SIZE_T when 64bit Windows came about. This change adjusts the binding we have for it in System.Win32 accordingly. For consistency with established practice, an s-win32 specific version of size_t is introduced and g-sercom__mingw.adb is adjusted to disambiguate between this new size_t and the one already exposed in System.CRTL. 2019-08-13 Olivier Hainque gcc/ada/ * libgnat/s-win32.ads: Define size_t and fix the MapViewOfFile binding to use it instead of DWORD for the dwNumberOfBytesToMap argument. * libgnat/g-sercom__mingw.adb (Read): State which definition of size_t to fetch in call to Last_Index. From-SVN: r274341 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/libgnat/g-sercom__mingw.adb | 2 +- gcc/ada/libgnat/s-win32.ads | 3 ++- 3 files changed, 11 insertions(+), 2 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a67cc5d..75d3d7b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-08-13 Olivier Hainque + + * libgnat/s-win32.ads: Define size_t and fix the MapViewOfFile + binding to use it instead of DWORD for the dwNumberOfBytesToMap + argument. + * libgnat/g-sercom__mingw.adb (Read): State which definition of + size_t to fetch in call to Last_Index. + 2019-08-13 Arnaud Charlet * gcc-interface/Make-lang.in: Remove unused TRACE variable. Pass diff --git a/gcc/ada/libgnat/g-sercom__mingw.adb b/gcc/ada/libgnat/g-sercom__mingw.adb index c13e7b3..d5e2344 100644 --- a/gcc/ada/libgnat/g-sercom__mingw.adb +++ b/gcc/ada/libgnat/g-sercom__mingw.adb @@ -167,7 +167,7 @@ package body GNAT.Serial_Communications is Raise_Error ("read error"); end if; - Last := Last_Index (Buffer'First, size_t (Read_Last)); + Last := Last_Index (Buffer'First, CRTL.size_t (Read_Last)); end Read; --------- diff --git a/gcc/ada/libgnat/s-win32.ads b/gcc/ada/libgnat/s-win32.ads index d09c4b3..ab832cd 100644 --- a/gcc/ada/libgnat/s-win32.ads +++ b/gcc/ada/libgnat/s-win32.ads @@ -63,6 +63,7 @@ package System.Win32 is type BYTE is new Interfaces.C.unsigned_char; type LONG is new Interfaces.C.long; type CHAR is new Interfaces.C.char; + type SIZE_T is new Interfaces.C.size_t; type BOOL is new Interfaces.C.int; for BOOL'Size use Interfaces.C.int'Size; @@ -238,7 +239,7 @@ package System.Win32 is dwDesiredAccess : DWORD; dwFileOffsetHigh : DWORD; dwFileOffsetLow : DWORD; - dwNumberOfBytesToMap : DWORD) return System.Address; + dwNumberOfBytesToMap : SIZE_T) return System.Address; pragma Import (Stdcall, MapViewOfFile, "MapViewOfFile"); function UnmapViewOfFile (lpBaseAddress : System.Address) return BOOL; -- cgit v1.1 From 2e8362bc219d6e900756128450c365dd31045a7b Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 13 Aug 2019 08:07:13 +0000 Subject: [Ada] Do not set Back_End_Inlining in ASIS mode No impact on compilation. 2019-08-13 Eric Botcazou gcc/ada/ * gnat1drv.adb (Adjust_Global_Switches): Do not set Back_End_Inlining in ASIS mode either. From-SVN: r274342 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/gnat1drv.adb | 4 ++++ 2 files changed, 9 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 75d3d7b..a8ef30f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-13 Eric Botcazou + + * gnat1drv.adb (Adjust_Global_Switches): Do not set + Back_End_Inlining in ASIS mode either. + 2019-08-13 Olivier Hainque * libgnat/s-win32.ads: Define size_t and fix the MapViewOfFile diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index ecb3ccd..1f42a44 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -803,6 +803,10 @@ procedure Gnat1drv is not Generate_C_Code + -- No back-end inlining available in ASIS mode + + and then not ASIS_Mode + -- No back-end inlining in GNATprove mode, since it just confuses -- the formal verification process. -- cgit v1.1 From 258325dddf752c578f1da15f63577090b1db2de5 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 13 Aug 2019 08:07:18 +0000 Subject: [Ada] Spurious error on nested instantiation This fixes a spurious error given by the compiler for a call to a subprogram which is the formal subprogram parameter of a generic package, if the generic package is instantiated in the body of an enclosing generic package with two formal types and two formal subprogram parameter homonyms taking them, and this instantiation takes one the two formal types as actual, and the enclosing generic package is instantiated on the same actual type with a single actual subprogram parameter, and the aforementioned call is overloaded. In this case, the renaming generated for the actual subprogram parameter in the nested instantiation is ambiguous and must be disambiguated using the corresponding formal parameter of the enclosing instantiation, otherwise a (sub)type mismatch is created and later subprogram disambiguation is not really possible. 2019-08-13 Eric Botcazou gcc/ada/ * sem_ch4.adb (Analyze_One_Call): Remove bypass for type mismatch in nested instantiations. * sem_ch8.adb (Find_Nearer_Entity): New function. (Find_Renamed_Entity): Use it to disambiguate the candidates for the renaming generated for an instantiation when it is ambiguous. gcc/testsuite/ * gnat.dg/generic_inst9.adb, gnat.dg/generic_inst9.ads, gnat.dg/generic_inst9_pkg1-operator.ads, gnat.dg/generic_inst9_pkg1.ads, gnat.dg/generic_inst9_pkg2.adb, gnat.dg/generic_inst9_pkg2.ads: New testcase. From-SVN: r274343 --- gcc/ada/ChangeLog | 9 ++++ gcc/ada/sem_ch4.adb | 53 -------------------- gcc/ada/sem_ch8.adb | 142 +++++++++++++++++++++++++++++++++++++++++++++++----- 3 files changed, 139 insertions(+), 65 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a8ef30f..34f41fd 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,14 @@ 2019-08-13 Eric Botcazou + * sem_ch4.adb (Analyze_One_Call): Remove bypass for type + mismatch in nested instantiations. + * sem_ch8.adb (Find_Nearer_Entity): New function. + (Find_Renamed_Entity): Use it to disambiguate the candidates for + the renaming generated for an instantiation when it is + ambiguous. + +2019-08-13 Eric Botcazou + * gnat1drv.adb (Adjust_Global_Switches): Do not set Back_End_Inlining in ASIS mode either. diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index f7b99d4..c049f9d 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -3619,59 +3619,6 @@ package body Sem_Ch4 is Next_Actual (Actual); Next_Formal (Formal); - -- In a complex case where an enclosing generic and a nested - -- generic package, both declared with partially parameterized - -- formal subprograms with the same names, are instantiated - -- with the same type, the types of the actual parameter and - -- that of the formal may appear incompatible at first sight. - - -- generic - -- type Outer_T is private; - -- with function Func (Formal : Outer_T) - -- return ... is <>; - - -- package Outer_Gen is - -- generic - -- type Inner_T is private; - -- with function Func (Formal : Inner_T) -- (1) - -- return ... is <>; - - -- package Inner_Gen is - -- function Inner_Func (Formal : Inner_T) -- (2) - -- return ... is (Func (Formal)); - -- end Inner_Gen; - -- end Outer_Generic; - - -- package Outer_Inst is new Outer_Gen (Actual_T); - -- package Inner_Inst is new Outer_Inst.Inner_Gen (Actual_T); - - -- In the example above, the type of parameter - -- Inner_Func.Formal at (2) is incompatible with the type of - -- Func.Formal at (1) in the context of instantiations - -- Outer_Inst and Inner_Inst. In reality both types are generic - -- actual subtypes renaming base type Actual_T as part of the - -- generic prologues for the instantiations. - - -- Recognize this case and add a type conversion to allow this - -- kind of generic actual subtype conformance. Note that this - -- is done only when the call is non-overloaded because the - -- resolution mechanism already has the means to disambiguate - -- similar cases. - - elsif not Is_Overloaded (Name (N)) - and then Is_Type (Etype (Actual)) - and then Is_Type (Etype (Formal)) - and then Is_Generic_Actual_Type (Etype (Actual)) - and then Is_Generic_Actual_Type (Etype (Formal)) - and then Base_Type (Etype (Actual)) = - Base_Type (Etype (Formal)) - then - Rewrite (Actual, - Convert_To (Etype (Formal), Relocate_Node (Actual))); - Analyze_And_Resolve (Actual, Etype (Formal)); - Next_Actual (Actual); - Next_Formal (Formal); - -- Handle failed type check else diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 7185c40..8795dc0 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -6721,6 +6721,15 @@ package body Sem_Ch8 is Old_S : Entity_Id; Inst : Entity_Id; + function Find_Nearer_Entity + (New_S : Entity_Id; + Old1_S : Entity_Id; + Old2_S : Entity_Id) return Entity_Id; + -- Determine whether one of Old_S1 and Old_S2 is nearer to New_S than + -- the other, and return it if so. Return Empty otherwise. We use this + -- in conjunction with Inherit_Renamed_Profile to simplify later type + -- disambiguation for actual subprograms in instances. + function Is_Visible_Operation (Op : Entity_Id) return Boolean; -- If the renamed entity is an implicit operator, check whether it is -- visible because its operand type is properly visible. This check @@ -6737,6 +6746,99 @@ package body Sem_Ch8 is -- enclosing instance. If yes, it has precedence over outer candidates. -------------------------- + -- Find_Nearer_Entity -- + -------------------------- + + function Find_Nearer_Entity + (New_S : Entity_Id; + Old1_S : Entity_Id; + Old2_S : Entity_Id) return Entity_Id + is + New_F : Entity_Id; + Old1_F : Entity_Id; + Old2_F : Entity_Id; + Anc_T : Entity_Id; + + begin + New_F := First_Formal (New_S); + Old1_F := First_Formal (Old1_S); + Old2_F := First_Formal (Old2_S); + + -- The criterion is whether the type of the formals of one of Old1_S + -- and Old2_S is an ancestor subtype of the type of the corresponding + -- formals of New_S while the other is not (we already know that they + -- are all subtypes of the same base type). + + -- This makes it possible to find the more correct renamed entity in + -- the case of a generic instantiation nested in an enclosing one for + -- which different formal types get the same actual type, which will + -- in turn make it possible for Inherit_Renamed_Profile to preserve + -- types on formal parameters and ultimately simplify disambiguation. + + -- Consider the follow package G: + + -- generic + -- type Item_T is private; + -- with function Compare (L, R: Item_T) return Boolean is <>; + + -- type Bound_T is private; + -- with function Compare (L, R : Bound_T) return Boolean is <>; + -- package G is + -- ... + -- end G; + + -- package body G is + -- package My_Inner is Inner_G (Bound_T); + -- ... + -- end G; + + -- with the following package Inner_G: + + -- generic + -- type T is private; + -- with function Compare (L, R: T) return Boolean is <>; + -- package Inner_G is + -- function "<" (L, R: T) return Boolean is (Compare (L, R)); + -- end Inner_G; + + -- If G is instantiated on the same actual type with a single Compare + -- function: + + -- type T is ... + -- function Compare (L, R : T) return Boolean; + -- package My_G is new (T, T); + + -- then the renaming generated for Compare in the inner instantiation + -- is ambiguous: it can rename either of the renamings generated for + -- the outer instantiation. Now if the first one is picked up, then + -- the subtypes of the formal parameters of the renaming will not be + -- preserved in Inherit_Renamed_Profile because they are subtypes of + -- the Bound_T formal type and not of the Item_T formal type, so we + -- need to arrange for the second one to be picked up instead. + + while Present (New_F) loop + if Etype (Old1_F) /= Etype (Old2_F) then + Anc_T := Ancestor_Subtype (Etype (New_F)); + + if Etype (Old1_F) = Anc_T then + return Old1_S; + elsif Etype (Old2_F) = Anc_T then + return Old2_S; + end if; + end if; + + Next_Formal (New_F); + Next_Formal (Old1_F); + Next_Formal (Old2_F); + end loop; + + pragma Assert (No (Old1_F)); + pragma Assert (No (Old2_F)); + + return Empty; + end Find_Nearer_Entity; + + -------------------------- -- Is_Visible_Operation -- -------------------------- @@ -6860,21 +6962,37 @@ package body Sem_Ch8 is if Present (Inst) then if Within (It.Nam, Inst) then if Within (Old_S, Inst) then - - -- Choose the innermost subprogram, which would - -- have hidden the outer one in the generic. - - if Scope_Depth (It.Nam) < - Scope_Depth (Old_S) - then - return Old_S; - else - return It.Nam; - end if; + declare + It_D : constant Uint := Scope_Depth (It.Nam); + Old_D : constant Uint := Scope_Depth (Old_S); + N_Ent : Entity_Id; + begin + -- Choose the innermost subprogram, which + -- would hide the outer one in the generic. + + if Old_D > It_D then + return Old_S; + elsif It_D > Old_D then + return It.Nam; + end if; + + -- Otherwise, if we can determine that one + -- of the entities is nearer to the renaming + -- than the other, choose it. If not, then + -- return the newer one as done historically. + + N_Ent := + Find_Nearer_Entity (New_S, Old_S, It.Nam); + if Present (N_Ent) then + return N_Ent; + else + return It.Nam; + end if; + end; end if; elsif Within (Old_S, Inst) then - return (Old_S); + return Old_S; else return Report_Overload; -- cgit v1.1 From 1788bf118c1c97a2e3cb8c0526ffe617859eb7d4 Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Tue, 13 Aug 2019 08:07:24 +0000 Subject: [Ada] Avoid crash in GNATprove due to inlining inside type The special inlining for GNATprove should not inline calls inside record types, used for the constraints of components. There is no impact on compilation. 2019-08-13 Yannick Moy gcc/ada/ * sem_res.adb (Resolve_Call): Do not inline calls inside record types. From-SVN: r274344 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem_res.adb | 9 +++++++++ 2 files changed, 14 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 34f41fd..55044f6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-13 Yannick Moy + + * sem_res.adb (Resolve_Call): Do not inline calls inside record + types. + 2019-08-13 Eric Botcazou * sem_ch4.adb (Analyze_One_Call): Remove bypass for type diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 759887c..7a9c85c 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -7062,6 +7062,15 @@ package body Sem_Res is end if; end if; + -- Cannot inline a call inside the definition of a record type, + -- typically inside the constraints of the type. Calls in + -- default expressions are also not inlined, but this is + -- filtered out above when testing In_Default_Expr. + + elsif Is_Record_Type (Current_Scope) then + Cannot_Inline + ("cannot inline & (inside record type)?", N, Nam_UA); + -- With the one-pass inlining technique, a call cannot be -- inlined if the corresponding body has not been seen yet. -- cgit v1.1 From ebad47fca4b9e8c33aea489c8fc2a633e4c36dd3 Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Tue, 13 Aug 2019 08:07:29 +0000 Subject: [Ada] Avoid crash in GNATprove_Mode on allocator inside type In the special mode for GNATprove, subtypes should be declared for allocators when constraints are used. This was done previously but it does not work inside spec expressions, as the declaration is not inserted and analyzed in the AST in that case, leading to a later crash on an incomplete entity. Thus, no declaration should be created in such a case, letting GNATprove later reject such code due to the use of an allocator in an interfering context. 2019-08-13 Yannick Moy gcc/ada/ * sem_ch4.adb (Analyze_Allocator): Do not insert subtype declaration for allocator inside a spec expression. gcc/testsuite/ * gnat.dg/allocator2.adb, gnat.dg/allocator2.ads: New testcase. From-SVN: r274345 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem_ch4.adb | 12 +++++++++--- 2 files changed, 14 insertions(+), 3 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 55044f6..920650b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2019-08-13 Yannick Moy + * sem_ch4.adb (Analyze_Allocator): Do not insert subtype + declaration for allocator inside a spec expression. + +2019-08-13 Yannick Moy + * sem_res.adb (Resolve_Call): Do not inline calls inside record types. diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index c049f9d..6272578 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -676,9 +676,15 @@ package body Sem_Ch4 is -- In GNATprove mode we need to preserve the link between -- the original subtype indication and the anonymous subtype, - -- to extend proofs to constrained acccess types. - - if Expander_Active or else GNATprove_Mode then + -- to extend proofs to constrained acccess types. We only do + -- that outside of spec expressions, otherwise the declaration + -- cannot be inserted and analyzed. In such a case, GNATprove + -- later rejects the allocator as it is not used here in + -- a non-interfering context (SPARK 4.8(2) and 7.1.3(12)). + + if Expander_Active + or else (GNATprove_Mode and then not In_Spec_Expression) + then Def_Id := Make_Temporary (Loc, 'S'); Insert_Action (E, -- cgit v1.1 From 4de811c54e9dc78f7bca540125fcce804a39bb7c Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Tue, 13 Aug 2019 08:07:35 +0000 Subject: [Ada] Implement pragma Max_Entry_Queue_Length This patch implements AI12-0164-1 for the aspect/pragma Max_Entry_Queue_Length. 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_Length => 2; -- OK entry B (Item : Integer); pragma Max_Entry_Queue_Length (SOMETHING); -- OK entry C (Item : Integer); -- OK entry D (Item : Integer) with Max_Entry_Queue_Length => 4; -- OK entry D (Item : Integer; Item_B : Integer) with Max_Entry_Queue_Length => Float'Digits; -- OK entry E (Item : Integer); pragma Max_Entry_Queue_Length (SOMETHING * 2); -- OK entry E (Item : Integer; Item_B : Integer); pragma Max_Entry_Queue_Length (11); -- OK entry F (Item : Integer; Item_B : Integer); pragma Pre (Variable = True); pragma Max_Entry_Queue_Length (11); -- OK entry G (Item : Integer; Item_B : Integer) with Pre => (Variable = True), Max_Entry_Queue_Length => 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_Length (40); -- ERROR -- Task type task type Task_Example is entry Insert (Item : in Integer) with Max_Entry_Queue_Length => 10; -- ERROR -- Entry family in task type entry A (Positive) (Item : in Integer) with Max_Entry_Queue_Length => 10; -- ERROR end Task_Example; Task_Ex : Task_Example; -- Aspect applied to protected type protected type Protected_Failure_0 with Max_Entry_Queue_Length => 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_Length (10); -- ERROR -- Duplicates entry A (Item : Integer) with Max_Entry_Queue_Length => 10; -- OK pragma Max_Entry_Queue_Length (4); -- ERROR entry B (Item : Integer); pragma Max_Entry_Queue_Length (40); -- OK pragma Max_Entry_Queue_Length (4); -- ERROR entry C (Item : Integer) with Max_Entry_Queue_Length => 10, -- OK Max_Entry_Queue_Length => 40; -- ERROR -- Duplicates with the same value entry AA (Item : Integer) with Max_Entry_Queue_Length => 10; -- OK pragma Max_Entry_Queue_Length (10); -- ERROR entry BB (Item : Integer); pragma Max_Entry_Queue_Length (40); -- OK pragma Max_Entry_Queue_Length (40); -- ERROR entry CC (Item : Integer) with Max_Entry_Queue_Length => 10, -- OK Max_Entry_Queue_Length => 10; -- ERROR -- On subprogram procedure D (Item : Integer) with Max_Entry_Queue_Length => 10; -- ERROR procedure E (Item : Integer); pragma Max_Entry_Queue_Length (4); -- ERROR function F (Item : Integer) return Integer with Max_Entry_Queue_Length => 10; -- ERROR function G (Item : Integer) return Integer; pragma Max_Entry_Queue_Length (4); -- ERROR -- Bad parameters entry H (Item : Integer) with Max_Entry_Queue_Length => 0; -- ERROR entry I (Item : Integer) with Max_Entry_Queue_Length => -1; -- ERROR entry J (Item : Integer) with Max_Entry_Queue_Length => 16#FFFF_FFFF_FFFF_FFFF_FFFF#; -- ERROR entry K (Item : Integer) with Max_Entry_Queue_Length => False; -- ERROR entry L (Item : Integer) with Max_Entry_Queue_Length => "JUNK"; -- ERROR entry M (Item : Integer) with Max_Entry_Queue_Length => 1.0; -- ERROR entry N (Item : Integer) with Max_Entry_Queue_Length => Long_Integer'(3); -- ERROR -- Entry family entry O (Boolean) (Item : Integer) with Max_Entry_Queue_Length => 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_Length (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_Entry_Queue_Length" must apply to a protected entry fail.ads:12:15: aspect "Max_Entry_Queue_Length" cannot apply to task entries fail.ads:17:15: aspect "Max_Entry_Queue_Length" cannot apply to task entries fail.ads:26:12: aspect "Max_Entry_Queue_Length" must apply to a protected entry fail.ads:36:07: pragma "Max_Entry_Queue_Length" must apply to a protected entry fail.ads:42:07: pragma "Max_Entry_Queue_Length" duplicates aspect declared at line 41 fail.ads:46:07: pragma "Max_Entry_Queue_Length" duplicates pragma declared at line 45 fail.ads:50:15: aspect "Max_Entry_Queue_Length" for "C" previously given at line 49 fail.ads:56:07: pragma "Max_Entry_Queue_Length" duplicates aspect declared at line 55 fail.ads:60:07: pragma "Max_Entry_Queue_Length" duplicates pragma declared at line 59 fail.ads:64:15: aspect "Max_Entry_Queue_Length" for "CC" previously given at line 63 fail.ads:69:15: aspect "Max_Entry_Queue_Length" must apply to a protected entry fail.ads:72:07: pragma "Max_Entry_Queue_Length" must apply to a protected entry fail.ads:75:15: aspect "Max_Entry_Queue_Length" must apply to a protected entry fail.ads:78:07: pragma "Max_Entry_Queue_Length" must apply to a protected entry fail.ads:83:35: entity for aspect "Max_Entry_Queue_Length" must be positive fail.ads:86:35: entity for aspect "Max_Entry_Queue_Length" must be positive fail.ads:89:35: entity for aspect "Max_Entry_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 2019-08-13 Justin Squirek 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_Entry_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_Length so that it can be processed as a pragma in addition to a restriction and add an entry for the pragma itself. From-SVN: r274346 --- gcc/ada/ChangeLog | 14 ++++++++++++++ gcc/ada/aspects.adb | 1 + gcc/ada/aspects.ads | 7 ++++++- gcc/ada/par-prag.adb | 1 + gcc/ada/sem_ch13.adb | 14 ++++++++++++++ gcc/ada/sem_prag.adb | 19 ++++++++++++------- gcc/ada/sem_prag.ads | 1 + gcc/ada/snames.ads-tmpl | 5 +++-- 8 files changed, 52 insertions(+), 10 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 920650b..3acda6a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2019-08-13 Justin Squirek + + * 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_Entry_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_Length so that it can be processed as a + pragma in addition to a restriction and add an entry for the + pragma itself. + 2019-08-13 Yannick Moy * sem_ch4.adb (Analyze_Allocator): Do not insert subtype diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index 4618749d..d582abf 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -572,6 +572,7 @@ package body Aspects is Aspect_Lock_Free => Aspect_Lock_Free, Aspect_Machine_Radix => Aspect_Machine_Radix, Aspect_Max_Entry_Queue_Depth => Aspect_Max_Entry_Queue_Depth, + Aspect_Max_Entry_Queue_Length => Aspect_Max_Entry_Queue_Length, Aspect_Max_Queue_Length => Aspect_Max_Queue_Length, Aspect_No_Caching => Aspect_No_Caching, Aspect_No_Elaboration_Code_All => Aspect_No_Elaboration_Code_All, diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 86eb722..64b0ff7 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -116,7 +116,8 @@ package Aspects is Aspect_Link_Name, Aspect_Linker_Section, -- GNAT Aspect_Machine_Radix, - Aspect_Max_Entry_Queue_Depth, + Aspect_Max_Entry_Queue_Depth, -- GNAT + Aspect_Max_Entry_Queue_Length, Aspect_Max_Queue_Length, -- GNAT Aspect_No_Caching, -- GNAT Aspect_Object_Size, -- GNAT @@ -253,6 +254,7 @@ package Aspects is Aspect_Invariant => True, Aspect_Lock_Free => True, Aspect_Max_Entry_Queue_Depth => True, + Aspect_Max_Entry_Queue_Length => True, Aspect_Max_Queue_Length => True, Aspect_Object_Size => True, Aspect_Persistent_BSS => True, @@ -376,6 +378,7 @@ package Aspects is Aspect_Linker_Section => Expression, Aspect_Machine_Radix => Expression, Aspect_Max_Entry_Queue_Depth => Expression, + Aspect_Max_Entry_Queue_Length => Expression, Aspect_Max_Queue_Length => Expression, Aspect_No_Caching => Optional_Expression, Aspect_Object_Size => Expression, @@ -487,6 +490,7 @@ package Aspects is Aspect_Lock_Free => Name_Lock_Free, Aspect_Machine_Radix => Name_Machine_Radix, Aspect_Max_Entry_Queue_Depth => Name_Max_Entry_Queue_Depth, + Aspect_Max_Entry_Queue_Length => Name_Max_Entry_Queue_Length, Aspect_Max_Queue_Length => Name_Max_Queue_Length, Aspect_No_Caching => Name_No_Caching, Aspect_No_Elaboration_Code_All => Name_No_Elaboration_Code_All, @@ -765,6 +769,7 @@ package Aspects is Aspect_Initial_Condition => Never_Delay, Aspect_Initializes => Never_Delay, Aspect_Max_Entry_Queue_Depth => Never_Delay, + Aspect_Max_Entry_Queue_Length => Never_Delay, Aspect_Max_Queue_Length => Never_Delay, Aspect_No_Caching => Never_Delay, Aspect_No_Elaboration_Code_All => Never_Delay, diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 9042b97..bed22e1 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -1415,6 +1415,7 @@ begin | Pragma_Main | Pragma_Main_Storage | Pragma_Max_Entry_Queue_Depth + | Pragma_Max_Entry_Queue_Length | Pragma_Max_Queue_Length | Pragma_Memory_Size | Pragma_No_Body diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 5ec3487..4ce248f 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -3014,6 +3014,19 @@ package body Sem_Ch13 is Insert_Pragma (Aitem); goto Continue; + -- Max_Entry_Queue_Length + + when Aspect_Max_Entry_Queue_Length => + Make_Aitem_Pragma + (Pragma_Argument_Associations => New_List ( + Make_Pragma_Argument_Association (Loc, + Expression => Relocate_Node (Expr))), + Pragma_Name => Name_Max_Entry_Queue_Length); + + Decorate (Aspect, Aitem); + Insert_Pragma (Aitem); + goto Continue; + -- Max_Queue_Length when Aspect_Max_Queue_Length => @@ -9651,6 +9664,7 @@ package body Sem_Ch13 is | Aspect_Initial_Condition | Aspect_Initializes | Aspect_Max_Entry_Queue_Depth + | Aspect_Max_Entry_Queue_Length | Aspect_Max_Queue_Length | Aspect_No_Caching | Aspect_Obsolescent diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 30b6088..0f822bf 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -19572,16 +19572,18 @@ package body Sem_Prag is end loop; end Main_Storage; - ---------------------- - -- Max_Queue_Length -- - ---------------------- + ---------------------------- + -- Max_Entry_Queue_Length -- + ---------------------------- - -- pragma Max_Queue_Length (static_integer_EXPRESSION); + -- pragma Max_Entry_Queue_Length (static_integer_EXPRESSION); - -- This processing is shared by Pragma_Max_Entry_Queue_Depth + -- This processing is shared by Pragma_Max_Entry_Queue_Depth and + -- Pragma_Max_Queue_Length. - when Pragma_Max_Queue_Length + when Pragma_Max_Entry_Queue_Length | Pragma_Max_Entry_Queue_Depth + | Pragma_Max_Queue_Length => Max_Queue_Length : declare Arg : Node_Id; @@ -19590,7 +19592,9 @@ package body Sem_Prag is Val : Uint; begin - if Prag_Id = Pragma_Max_Queue_Length then + if Prag_Id = Pragma_Max_Entry_Queue_Depth + or else Prag_Id = Pragma_Max_Queue_Length + then GNAT_Pragma; end if; @@ -31059,6 +31063,7 @@ package body Sem_Prag is Pragma_Main => -1, Pragma_Main_Storage => -1, Pragma_Max_Entry_Queue_Depth => 0, + Pragma_Max_Entry_Queue_Length => 0, Pragma_Max_Queue_Length => 0, Pragma_Memory_Size => 0, Pragma_No_Body => 0, diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads index 941a723..4978299 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -399,6 +399,7 @@ package Sem_Prag is -- Global -- Initializes -- Max_Entry_Queue_Depth + -- Max_Entry_Queue_Length -- Max_Queue_Length -- Post -- Post_Class diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index ef6b17c..d7507a2 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -592,7 +592,8 @@ package Snames is Name_Machine_Attribute : constant Name_Id := N + $; -- GNAT Name_Main : constant Name_Id := N + $; -- GNAT Name_Main_Storage : constant Name_Id := N + $; -- GNAT - Name_Max_Entry_Queue_Depth : constant Name_Id := N + $; -- Ada 12 + Name_Max_Entry_Queue_Depth : constant Name_Id := N + $; -- GNAT + Name_Max_Entry_Queue_Length : constant Name_Id := N + $; -- Ada 12 Name_Max_Queue_Length : constant Name_Id := N + $; -- GNAT Name_Memory_Size : constant Name_Id := N + $; -- Ada 83 Name_No_Body : constant Name_Id := N + $; -- GNAT @@ -782,7 +783,6 @@ package Snames is Name_Link_Name : constant Name_Id := N + $; Name_Low_Order_First : constant Name_Id := N + $; Name_Lowercase : constant Name_Id := N + $; - Name_Max_Entry_Queue_Length : constant Name_Id := N + $; Name_Max_Size : constant Name_Id := N + $; Name_Mechanism : constant Name_Id := N + $; Name_Message : constant Name_Id := N + $; @@ -2007,6 +2007,7 @@ package Snames is Pragma_Main, Pragma_Main_Storage, Pragma_Max_Entry_Queue_Depth, + Pragma_Max_Entry_Queue_Length, Pragma_Max_Queue_Length, Pragma_Memory_Size, Pragma_No_Body, -- cgit v1.1 From 6aaab5081f44b00b78e9550b5a33ba81f85c162c Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Tue, 13 Aug 2019 08:07:41 +0000 Subject: [Ada] Show Bit_Order and Scalar_Storage_Order in -gnatR4 output This patch modifies the behavior of -gnatR4 so that representation information for bit and scalar storage order gets displayed in all cases and not just when defaults are overriden. ------------ -- Source -- ------------ -- pkg.ads package Pkg is type Root is tagged record Data0 : Integer; end record; type Derived is new Root with record Data1 : Integer; end record; end Pkg; ----------------- -- Compilation -- ----------------- $ gnatmake -gnatR4 pkg.ads Representation information for unit Pkg (spec) ---------------------------------------------- for Root'Size use 128; for Root'Alignment use 8; for Root use record Data0 at 8 range 0 .. 31; end record; for Root'Bit_Order use System.Low_Order_First; for Root'Scalar_Storage_Order use System.Low_Order_First; for Trootc'Size use 0; for Trootc'Alignment use 0; for Trootc use record end record; for Trootc'Bit_Order use System.Low_Order_First; for Trootc'Scalar_Storage_Order use System.Low_Order_First; for Derived'Size use 192; for Derived'Alignment use 8; for Derived use record Data0 at 8 range 0 .. 31; Data1 at 16 range 0 .. 31; end record; for Derived'Bit_Order use System.Low_Order_First; for Derived'Scalar_Storage_Order use System.Low_Order_First; for Tderivedc'Size use 0; for Tderivedc'Alignment use 0; for Tderivedc use record Data0 at 8 range 0 .. 31; Data1 at 16 range 0 .. 31; end record; for Tderivedc'Bit_Order use System.Low_Order_First; for Tderivedc'Scalar_Storage_Order use System.Low_Order_First;i 2019-08-13 Justin Squirek gcc/ada/ * repinfo.adb (List_Scalar_Storage_Order): Modify conditionals for displaying ordering to always be triggered when -gnatR4 is in effect. From-SVN: r274347 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/repinfo.adb | 11 +++++++++-- 2 files changed, 15 insertions(+), 2 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3acda6a..ade7e68 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,11 @@ 2019-08-13 Justin Squirek + * repinfo.adb (List_Scalar_Storage_Order): Modify conditionals + for displaying ordering to always be triggered when -gnatR4 is + in effect. + +2019-08-13 Justin Squirek + * aspects.adb, aspects.ads: Register new aspect. * par-prag.adb (Prag): Register new pragma * sem_ch13.adb (Analyze_Aspect_Specifications): Add processing diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index 77b5c21..d168e90 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -1816,8 +1816,15 @@ package body Repinfo is begin -- For record types, list Bit_Order if not default, or if SSO is shown + -- Also, when -gnatR4 is in effect always list bit order and scalar + -- storage order explicitly, so that you don't need to know the native + -- endianness of the target for which the output was produced in order + -- to interpret it. + if Is_Record_Type (Ent) - and then (List_SSO or else Reverse_Bit_Order (Ent)) + and then (List_SSO + or else Reverse_Bit_Order (Ent) + or else List_Representation_Info = 4) then List_Attr ("Bit_Order", Reverse_Bit_Order (Ent)); end if; @@ -1825,7 +1832,7 @@ package body Repinfo is -- List SSO if required. If not, then storage is supposed to be in -- native order. - if List_SSO then + if List_SSO or else List_Representation_Info = 4 then List_Attr ("Scalar_Storage_Order", Reverse_Storage_Order (Ent)); else pragma Assert (not Reverse_Storage_Order (Ent)); -- cgit v1.1 From 4167b0752365c69e5895b5c8097e7dba34f735f5 Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Tue, 13 Aug 2019 08:07:46 +0000 Subject: [Ada] Compiler may blow up on array aggregates whose size is very large The compiler may crash when compiling array aggregates where the computation of the size produces a very large number that overflows (possibly producing a small result), such as with an aggregate of a type that is an array of arrays, where each array range has close to Integer'Last elements. That can lead to Aggr_Size_OK returning incorrectly returning True, following on to allocating a very large array in function Flatten that blows the stack. The size computation was being performed using type Int, so this was changed to use universal arithmetic. 2019-08-13 Gary Dismukes gcc/ada/ * exp_aggr.adb (Aggr_Size_OK): Compute the aggregate size using universal arithmetic, to avoid situations where the size computation overflows. gcc/testsuite/ * gnat.dg/aggr26.adb: New testcase. From-SVN: r274348 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/exp_aggr.adb | 21 ++++++++++++--------- 2 files changed, 18 insertions(+), 9 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ade7e68..415f950 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-13 Gary Dismukes + + * exp_aggr.adb (Aggr_Size_OK): Compute the aggregate size using + universal arithmetic, to avoid situations where the size + computation overflows. + 2019-08-13 Justin Squirek * repinfo.adb (List_Scalar_Storage_Order): Modify conditionals diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index c944db6..925d6ae 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -344,7 +344,7 @@ package body Exp_Aggr is Lo : Node_Id; Hi : Node_Id; Indx : Node_Id; - Siz : Int; + Size : Uint; Lov : Uint; Hiv : Uint; @@ -468,7 +468,7 @@ package body Exp_Aggr is Max_Aggr_Size := 5000; end if; - Siz := Component_Count (Component_Type (Typ)); + Size := UI_From_Int (Component_Count (Component_Type (Typ))); Indx := First_Index (Typ); while Present (Indx) loop @@ -538,14 +538,17 @@ package body Exp_Aggr is return False; end if; - Siz := Siz * UI_To_Int (Rng); - end; + -- Compute the size using universal arithmetic to avoid the + -- possibility of overflow on very large aggregates. - if Siz <= 0 - or else Siz > Max_Aggr_Size - then - return False; - end if; + Size := Size * Rng; + + if Size <= 0 + or else Size > Max_Aggr_Size + then + return False; + end if; + end; -- Bounds must be in integer range, for later array construction -- cgit v1.1 From 93bfc8c003e7367f0f873b566833a12c092b2755 Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Tue, 13 Aug 2019 08:07:51 +0000 Subject: [Ada] Do full name qualification of local exception names for LLVM Exceptions declared within subprograms are associated with objects allocated statically (at the global level), and it's helpful for the LLVM compiler (and likely others, such as CCG) if the exception name is fully qualified, to avoid link name clashes (gcc-based GNAT has always "uniquified" these names). GNAT was using the simple name for local exceptions (as for other local objects), but it now uses fully qualified names for all exceptions. When compiled with the command: gcc -c -gnatG local_exception.adb | grep "local_exception__local_exc" the following output is generated for the test further below: local_exception__local_exc : static exception := ( local_exception__local_exc'unrestricted_access)); procedure Local_Exception is Local_Exc : exception; begin null; end Local_Exception; 2019-08-13 Gary Dismukes gcc/ada/ * exp_dbug.adb (Fully_Qualify_Name): Add full name qualification for the E_Exception case. From-SVN: r274349 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/exp_dbug.adb | 1 + 2 files changed, 6 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 415f950..d9b7572 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2019-08-13 Gary Dismukes + * exp_dbug.adb (Fully_Qualify_Name): Add full name qualification + for the E_Exception case. + +2019-08-13 Gary Dismukes + * exp_aggr.adb (Aggr_Size_OK): Compute the aggregate size using universal arithmetic, to avoid situations where the size computation overflows. diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb index f0df5e2..3dbe9ad 100644 --- a/gcc/ada/exp_dbug.adb +++ b/gcc/ada/exp_dbug.adb @@ -1539,6 +1539,7 @@ package body Exp_Dbug is elsif Is_Subprogram (Ent) or else Ekind (Ent) = E_Subprogram_Body or else Is_Type (Ent) + or else Ekind (Ent) = E_Exception then Fully_Qualify_Name (Ent); Name_Len := Full_Qualify_Len; -- cgit v1.1 From 9e42b1920b40e5f1f2dd5443f48d28b38dd32af6 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Tue, 13 Aug 2019 08:07:56 +0000 Subject: [Ada] Add conformance check on actual subp. in instance of child unit This patch properly diagnoses a conformance error between a formal subprogram and the corresponding actual, when the instance is that of a child unit that is instantiated as a compilation unit. The error is normally suppressed on an instantiation nested within another generic, given that analysis of the enclosing generic will have performed the conformance check on the nested instance already. In the case of a child unit, its instantiation requires an explicit check if it is a compilation unit, because it has not been analyzed in the context of the parent generic. Compiling test.adb must yield: container-list.ads:3:01: instantiation error at new_container_g-list_g.ads:12 container-list.ads:3:01: not mode conformant with declaration at types.ads:5 container-list.ads:3:01: mode of "Self" does not match ---- with New_Container_G.List_G; pragma Elaborate_All (New_Container_G.List_G); package Container.List is new Container.List_G (Init => Types.Init_Object); with Types; with Erreur; with New_Container_G; pragma Elaborate_All (New_Container_G); package Container is new New_Container_G ( Element_T => Types.Integer_T, Pos_Range_T => Types.Integer_Idx_T, Container_Name => Erreur.None); package Erreur is type Container_Name_T is (None, Everything); end; ---- package body New_Container_G.List_G is function Get_Element_At_Pos (Self : access List_T; Pos : in Index_Range_T) return Element_Ptr is begin if not Self.T_Status (Pos) then Erreur.Treat_Container_Error (Error_Name => Erreur.Element_Not_Valid, Container_Name => Container_Name, Procedure_Name => Erreur.Get_Element_Ptr_At_Pos, Context => Erreur.Null_Context_C); end if; return Pos; end Get_Element_At_Pos; function Get_Element_At_Pos (Self : in List_T; Pos : in Index_Range_T) return Element_T is begin if not Self.T_Status (Pos) then Erreur.Treat_Container_Error (Error_Name => Erreur.Element_Not_Valid, Container_Name => Container_Name, Procedure_Name => Erreur.Get_Element_At_Pos, Context => Erreur.Null_Context_C); end if; return Self.Data (Pos); end Get_Element_At_Pos; procedure Add_New (Self : in out List_T; Pos : out Pos_Range_T) is Free_Found : Boolean := False; begin if Self.First_Free = Rbc_Constants.Null_Pos then Pos := Rbc_Constants.Null_Pos; else Self.Size := Self.Size + 1; Self.T_Status (Self.First_Free) := True; Pos := Self.First_Free; Init (Self.Data (Pos)); if Self.First_Relevant not in Rbc_Constants.Null_Pos + 1 .. Self.First_Free then Self.First_Relevant := Self.First_Free; end if; while not (Free_Found or Self.First_Free = Rbc_Constants.Null_Pos) loop if Self.First_Free = Pos_Range_T'Last then Self.First_Free := Rbc_Constants.Null_Pos; else Self.First_Free := Self.First_Free + 1; if not Self.T_Status (Self.First_Free) then Free_Found := True; end if; end if; end loop; end if; end Add_New; procedure Add_New_At_Pos (Self : in out List_T; Pos : in out Index_Range_T) is Free_Found : Boolean := False; begin if Self.T_Status (Pos) then Erreur.Treat_Container_Error (Error_Name => Erreur.Element_Not_Valid, Container_Name => Container_Name, Procedure_Name => Erreur.Add_New_At_Pos, Context => Erreur.Null_Context_C); else Self.Size := Self.Size + 1; Self.T_Status (Pos) := True; Init (Self.Data (Pos)); if Self.First_Relevant = Rbc_Constants.Null_Pos or Pos < Self.First_Relevant then Self.First_Relevant := Pos; end if; if Self.First_Free = Pos then -- Look for a new First_Free while not (Free_Found or Self.First_Free = Rbc_Constants.Null_Pos) loop if Self.First_Free = Pos_Range_T'Last then Self.First_Free := Rbc_Constants.Null_Pos; else Self.First_Free := Self.First_Free + 1; if not Self.T_Status (Self.First_Free) then Free_Found := True; end if; end if; end loop; end if; ------------------------------------------------------------------------- end if; end Add_New_At_Pos; procedure Clear (Self : out List_T) is begin Self.T_Status := (others => False); Self.First_Free := Init_First_Free; Self.First_Relevant := Rbc_Constants.Null_Pos; Self.Size := Empty; end Clear; procedure Remove_Element_At_Pos (Self : in out List_T; Pos : in Index_Range_T) is Relevant_Found : Boolean := False; begin -- REMOVE ITEM IF VALID --------------------------------------------- if not Self.T_Status (Pos) then Erreur.Treat_Container_Error (Error_Name => Erreur.Element_Not_Valid, Container_Name => Container_Name, Procedure_Name => Erreur.Remove_Element_At_Pos, Context => Erreur.Null_Context_C); end if; Self.Size := Self.Size - 1; Self.T_Status (Pos) := False; if Self.First_Free not in Rbc_Constants.Null_Pos + 1 .. Pos then Self.First_Free := Pos; end if; -- UPDATE FIRST_RELEVANT IF NECESSARY ----------------------------------- if Self.First_Relevant = Pos then while not (Relevant_Found or Self.First_Relevant = Rbc_Constants.Null_Pos) loop if Self.First_Relevant = Pos_Range_T'Last then Self.First_Relevant := Rbc_Constants.Null_Pos; else Self.First_Relevant := Self.First_Relevant + 1; if Self.T_Status (Self.First_Relevant) then Relevant_Found := True; end if; end if; end loop; end if; ------------------------------------------------------------------------- end Remove_Element_At_Pos; procedure Next (It : in out Iterator_T; Self : in List_T) is Relevant_Found : Boolean := False; begin if It = Rbc_Constants.Null_Pos then Erreur.Treat_Container_Error (Error_Name => Erreur.Iterator_Not_Valid, Container_Name => Container_Name, Procedure_Name => Erreur.Next, Context => Erreur.Null_Context_C); end if; while not (Relevant_Found or It = Rbc_Constants.Null_Pos) loop if It = Pos_Range_T'Last then It := Rbc_Constants.Null_Pos; else It := It + 1; if Self.T_Status (It) then Relevant_Found := True; end if; end if; end loop; end Next; function New_Iterator (Self : in List_T) return Iterator_T is begin return Self.First_Relevant; end New_Iterator; function Get (It : in Iterator_T; Self : in List_T) return Element_Ptr is begin if It = Rbc_Constants.Null_Pos or else not Self.T_Status (It) then Erreur.Treat_Container_Error (Error_Name => Erreur.Iterator_Not_Valid, Container_Name => Container_Name, Procedure_Name => Erreur.Get_Ptr, Context => Erreur.Null_Context_C); end if; return It; end Get; function Get (It : in Iterator_T; Self : in List_T) return Element_T is begin if It = Rbc_Constants.Null_Pos or else not Self.T_Status (It) then Erreur.Treat_Container_Error (Error_Name => Erreur.Iterator_Not_Valid, Container_Name => Container_Name, Procedure_Name => Erreur.Get, Context => Erreur.Null_Context_C); end if; return Self.Data (It); end Get; function Getstatus (Self : in List_T; Pos : in Index_Range_T) return Boolean is begin return Self.T_Status (Pos); end Getstatus; function Init_First_Free return Pos_Range_T is First_Free_Value : Pos_Range_T; begin if Full = Rbc_Constants.Null_Pos then -- size is 0 First_Free_Value := Rbc_Constants.Null_Pos; else -- first free cell index is 1 First_Free_Value := Index_Range_T'First; end if; return First_Free_Value; end Init_First_Free; end New_Container_G.List_G; with Rbc_Constants; generic with procedure Init (Self : out Element_T); package New_Container_G.List_G is type List_T is new Container_T with private; function Get_Element_At_Pos (Self : access List_T; Pos : in Index_Range_T) return Element_Ptr; function Get_Element_At_Pos (Self : in List_T; Pos : in Index_Range_T) return Element_T; procedure Add_New (Self : in out List_T; Pos : out Pos_Range_T); procedure Add_New_At_Pos (Self : in out List_T; Pos : in out Index_Range_T); procedure Clear (Self : out List_T); procedure Remove_Element_At_Pos (Self : in out List_T; Pos : in Index_Range_T); procedure Next (It : in out Iterator_T; Self : in List_T); function New_Iterator (Self : in List_T) return Iterator_T; function Get (It : in Iterator_T; Self : in List_T) return Element_Ptr; function Get (It : in Iterator_T; Self : in List_T) return Element_T; function Getstatus (Self : in List_T; Pos : in Index_Range_T) return Boolean; private function Init_First_Free return Pos_Range_T; type Status_Array_T is array (Index_Range_T) of Boolean; type List_T is new Container_T with record T_Status : Status_Array_T := (others => False); First_Free : Pos_Range_T := Init_First_Free; First_Relevant : Pos_Range_T := Rbc_Constants.Null_Pos; end record; end New_Container_G.List_G; with Types_Alstom; use Types_Alstom; with Rbc_Constants; package body New_Container_G is function Done (It : in Iterator_T; Self : in Container_T) return Boolean is pragma Unreferenced (Self); Report : Boolean; begin if It = Rbc_Constants.Null_Pos then Report := True; else Report := False; end if; return Report; end Done; procedure Execute (Self : in out Container_T'class; This_Proc : in Proc_Access_T) is begin for I in Self.Data'First .. Self.Size loop This_Proc (Self.Data (I)); end loop; end Execute; procedure Execute (Self : in out Container_T'class; This_Proc : in Proc_Idx_Access_T) is begin for I in Self.Data'First .. Self.Size loop This_Proc (Self.Data (I), I); end loop; end Execute; function Selected_Subset (Self : in Container_T'Class; Ref : in Reference_T) return Element_Set_T is Set : Element_Set_T := (others => Rbc_Constants.Null_Pos); Current : Pos_Range_T := 0; begin for I in Self.Data'Range loop if Getstatus (Self, I) and then Is_Selected (Elem => Self.Data (I), Ref => Ref) then Current := Current + 1; Set (Current) := I; end if; end loop; return Set; end Selected_Subset; function Selected_Element (Self : in Container_T'Class; Ref : in Reference_T) return Element_Ptr is begin for I in Self.Data'Range loop if Getstatus (Self, I) and then Is_Selected (Elem => Self.Data (I), Ref => Ref) then return I; end if; end loop; return Rbc_Constants.Null_Pos; end Selected_Element; function Getsize (Self : in Container_T) return Pos_Range_T is begin return Self.Size; end Getsize; end New_Container_G; with Types; with Erreur; generic -- Type of element to be stored type Element_T is private; type Pos_Range_T is range <>; Container_Name : in Erreur.Container_Name_T; package New_Container_G is pragma Unreferenced (Container_Name); subtype Element_Acc_T is Pos_Range_T; subtype Element_Ptr is Element_Acc_T; -- for compatibility subtype Iterator_T is Pos_Range_T; subtype Index_Range_T is Pos_Range_T range 1 .. Pos_Range_T'Last; type Element_Set_T is array (Index_Range_T) of Element_Ptr; Full : constant Pos_Range_T := Pos_Range_T'Last; Empty : constant Pos_Range_T := Pos_Range_T'First; type Element_Array_T is array (Index_Range_T) of Element_T; type Container_T is abstract tagged record Data : Element_Array_T; Size : Pos_Range_T := Empty; end record; function Get (It : in Iterator_T; Self : in Container_T) return Element_Ptr is abstract; function Get (It : in Iterator_T; Self : in Container_T) return Element_T is abstract; procedure Next (It : in out Iterator_T; Self : in Container_T) is abstract; function Done (It : in Iterator_T; Self : in Container_T) return Boolean; type Proc_Access_T is access procedure (Elem : in out Element_T); type Proc_Idx_Access_T is access procedure (Elem : in out Element_T; Idx : in Index_Range_T); procedure Execute (Self : in out Container_T'class; This_Proc : in Proc_Access_T); procedure Execute (Self : in out Container_T'class; This_Proc : in Proc_Idx_Access_T); function Getstatus (Self : in Container_T; Pos : in Index_Range_T) return Boolean is abstract; generic -- Type of the parameter of the is_selected () function. type Reference_T is private; with function Is_Selected (Elem : in Element_T; Ref : in Reference_T) return Boolean; function Selected_Subset (Self : in Container_T'Class; Ref : in Reference_T) return Element_Set_T; generic -- Type of the parameter of the is_selected () function. type Reference_T is private; with function Is_Selected (Elem : in Element_T; Ref : in Reference_T) return Boolean; function Selected_Element (Self : in Container_T'Class; Ref : in Reference_T) return Element_Ptr; function Getsize (Self : in Container_T) return Pos_Range_T; end New_Container_G; ---- package Rbc_Constants is Null_Pos : constant := 0; Irrelevant_Id : constant String := " "; Nmax_Mc_Bits : constant := 32; end Rbc_Constants; with Ada.Text_IO; with Types; with Container.List; procedure Test is List : Container.List.List_T; Pos : Types.Integer_Idx_T; begin Container.List.Add_New (Self => List, Pos => Pos); Ada.Text_IO.Put_Line ("no exception raised"); end Test; package Types is type Integer_T is range -1000 .. 1000; type Integer_Idx_T is range 0 .. 100; procedure Init_Object (Elem : in Integer_T); end Types; 2019-08-13 Ed Schonberg gcc/ada/ * sem_ch8.adb (Analyze_Subprogram_Renaming): Do no suppress mode conformance checks on child unit instance that is a compilation unit. From-SVN: r274350 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/sem_ch8.adb | 11 ++++++++++- 2 files changed, 16 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d9b7572..bd3450f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-13 Ed Schonberg + + * sem_ch8.adb (Analyze_Subprogram_Renaming): Do no suppress mode + conformance checks on child unit instance that is a compilation + unit. + 2019-08-13 Gary Dismukes * exp_dbug.adb (Fully_Qualify_Name): Add full name qualification diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 8795dc0..38c3980 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -3368,7 +3368,16 @@ package body Sem_Ch8 is if CW_Actual then null; - elsif not Is_Actual or else No (Enclosing_Instance) then + + -- No need for a redundant error message if this is a nested + -- instance, unless the current instantiation (of a child unit) + -- is a compilation unit, which is not analyzed when the parent + -- generic is analyzed. + + elsif not Is_Actual + or else No (Enclosing_Instance) + or else Is_Compilation_Unit (Current_Scope) + then Check_Mode_Conformant (New_S, Old_S); end if; -- cgit v1.1 From aa1b718b769c34f35c66ed11e516a350fc51d547 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 13 Aug 2019 08:08:01 +0000 Subject: [Ada] Protect analysis of Indexing aspect against cascaded errors 2019-08-13 Arnaud Charlet gcc/ada/ * sem_ch13.adb (Check_Iterator_Functions): Protect against cascaded errors. From-SVN: r274351 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem_ch13.adb | 6 ++++-- 2 files changed, 9 insertions(+), 2 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index bd3450f..162d027 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-13 Arnaud Charlet + + * sem_ch13.adb (Check_Iterator_Functions): Protect against + cascaded errors. + 2019-08-13 Ed Schonberg * sem_ch8.adb (Analyze_Subprogram_Renaming): Do no suppress mode diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 4ce248f..8c5c424 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -4653,10 +4653,12 @@ package body Sem_Ch13 is end if; if not Is_Overloaded (Expr) then - if not Check_Primitive_Function (Entity (Expr)) then + if Entity (Expr) /= Any_Id + and then not Check_Primitive_Function (Entity (Expr)) + then Error_Msg_NE ("aspect Indexing requires a function that applies to type&", - Entity (Expr), Ent); + Entity (Expr), Ent); end if; -- Flag the default_iterator as well as the denoted function. -- cgit v1.1 From 063907abadf6ee9ffe4d60d4b61eb8a144aa29f7 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 13 Aug 2019 08:08:06 +0000 Subject: [Ada] Fix bogus style check failure with pragma Style_Checks (Off) This fixes a bogus style check failure for long lines in rare cases where the compiler is invoked, with a -gnatyX switch where X is neither 'm' nor 'M', on a unit which contains "with" clauses for other units that contain a pragma Style_Checks (Off). 2019-08-13 Eric Botcazou gcc/ada/ * sem.adb (Do_Analyze): Recompute Style_Check_Max_Line_Length after restoring Style_Max_Line_Length. From-SVN: r274352 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem.adb | 1 + 2 files changed, 6 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 162d027..a34c4ee 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-13 Eric Botcazou + + * sem.adb (Do_Analyze): Recompute Style_Check_Max_Line_Length + after restoring Style_Max_Line_Length. + 2019-08-13 Arnaud Charlet * sem_ch13.adb (Check_Iterator_Functions): Protect against diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 2f8f6a4..9b6b335 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -1395,6 +1395,7 @@ package body Sem is Restore_Scope_Stack (List); Restore_Ghost_Region (Saved_GM, Saved_IGR); Style_Max_Line_Length := Saved_ML; + Style_Check_Max_Line_Length := Style_Max_Line_Length /= 0; end Do_Analyze; -- Local variables -- cgit v1.1 From 49209838d35fbf7a130738be6eb0c281a40e8f20 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 13 Aug 2019 08:08:11 +0000 Subject: [Ada] Small cleanup and improvement in inlining machinery This is a small cleanup in the inlining machinery of the front-end dealing with back-end inlining. It should save a few cycles at -O0 by stopping it from doing useless work. No functional changes. 2019-08-13 Eric Botcazou gcc/ada/ * exp_ch6.adb: Remove with and use clauses for Sem_Ch12. (Expand_Call_Helper): Swap the back-end inlining case and the special front-end expansion case. In back-end inlining mode, do not invoke Add_Inlined_Body unless the call may be inlined. * inline.ads (Add_Pending_Instantiation): New function moved from... * inline.adb (Add_Inlined_Body): Simplify comment. Turn test on the enclosing unit into assertion. (Add_Pending_Instantiation): New function moved from... * sem_ch12.ads (Add_Pending_Instantiation): ...here. * sem_ch12.adb (Add_Pending_Instantiation): ...here. From-SVN: r274353 --- gcc/ada/ChangeLog | 14 ++++++++++++++ gcc/ada/exp_ch6.adb | 54 +++++++++++++++++++++++++--------------------------- gcc/ada/inline.adb | 31 ++++++++++++++++++++++++------ gcc/ada/inline.ads | 3 +++ gcc/ada/sem_ch12.adb | 20 ------------------- gcc/ada/sem_ch12.ads | 4 ---- 6 files changed, 68 insertions(+), 58 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a34c4ee..9a97482 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,19 @@ 2019-08-13 Eric Botcazou + * exp_ch6.adb: Remove with and use clauses for Sem_Ch12. + (Expand_Call_Helper): Swap the back-end inlining case and the + special front-end expansion case. In back-end inlining mode, do + not invoke Add_Inlined_Body unless the call may be inlined. + * inline.ads (Add_Pending_Instantiation): New function moved + from... + * inline.adb (Add_Inlined_Body): Simplify comment. Turn test on + the enclosing unit into assertion. + (Add_Pending_Instantiation): New function moved from... + * sem_ch12.ads (Add_Pending_Instantiation): ...here. + * sem_ch12.adb (Add_Pending_Instantiation): ...here. + +2019-08-13 Eric Botcazou + * sem.adb (Do_Analyze): Recompute Style_Check_Max_Line_Length after restoring Style_Max_Line_Length. diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 4fd3860..128fb90 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -60,7 +60,6 @@ with Sem; use Sem; with Sem_Aux; use Sem_Aux; 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_Dim; use Sem_Dim; with Sem_Disp; use Sem_Disp; @@ -4316,15 +4315,15 @@ package body Exp_Ch6 is if not Is_Inlined (Subp) then null; - -- Frontend inlining of expression functions (performed also when - -- backend inlining is enabled). + -- Front-end inlining of expression functions (performed also when + -- back-end inlining is enabled). elsif Is_Inlinable_Expression_Function (Subp) then Rewrite (N, New_Copy (Expression_Of_Expression_Function (Subp))); Analyze (N); return; - -- Handle frontend inlining + -- Handle front-end inlining elsif not Back_End_Inlining then Inlined_Subprogram : declare @@ -4420,27 +4419,36 @@ package body Exp_Ch6 is end if; end Inlined_Subprogram; - -- Back end inlining: let the back end handle it + -- Front-end expansion of simple functions returning unconstrained + -- types (see Check_And_Split_Unconstrained_Function). Note that the + -- case of a simple renaming (Body_To_Inline in N_Entity below, see + -- also Build_Renamed_Body) cannot be expanded here because this may + -- give rise to order-of-elaboration issues for the types of the + -- parameters of the subprogram, if any. + + elsif Present (Unit_Declaration_Node (Subp)) + and then Nkind (Unit_Declaration_Node (Subp)) = + N_Subprogram_Declaration + and then Present (Body_To_Inline (Unit_Declaration_Node (Subp))) + and then + Nkind (Body_To_Inline (Unit_Declaration_Node (Subp))) not in + N_Entity + then + Expand_Inlined_Call (Call_Node, Subp, Orig_Subp); + + -- Back-end inlining either if optimization is enabled or the call is + -- required to be inlined. - elsif No (Unit_Declaration_Node (Subp)) - or else Nkind (Unit_Declaration_Node (Subp)) /= - N_Subprogram_Declaration - or else No (Body_To_Inline (Unit_Declaration_Node (Subp))) - or else Nkind (Body_To_Inline (Unit_Declaration_Node (Subp))) in - N_Entity + elsif Optimization_Level > 0 + or else Has_Pragma_Inline_Always (Subp) then Add_Inlined_Body (Subp, Call_Node); - -- If the inlined call appears within an instantiation and either - -- is required to be inlined or optimization is enabled, ensure + -- If the inlined call appears within an instance, then ensure -- that the enclosing instance body is available so the back end -- can actually perform the inlining. - if In_Instance - and then Comes_From_Source (Subp) - and then (Has_Pragma_Inline_Always (Subp) - or else Optimization_Level > 0) - then + if In_Instance and then Comes_From_Source (Subp) then declare Decl : Node_Id; Inst : Entity_Id; @@ -4491,16 +4499,6 @@ package body Exp_Ch6 is end if; end; end if; - - -- Front end expansion of simple functions returning unconstrained - -- types (see Check_And_Split_Unconstrained_Function). Note that the - -- case of a simple renaming (Body_To_Inline in N_Entity above, see - -- also Build_Renamed_Body) cannot be expanded here because this may - -- give rise to order-of-elaboration issues for the types of the - -- parameters of the subprogram, if any. - - else - Expand_Inlined_Call (Call_Node, Subp, Orig_Subp); end if; end if; diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 5b7fefc..3a3ec0c 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -485,9 +485,7 @@ package body Inline is -- is the case for an initialization procedure, which appears in the -- package declaration that contains the type. It is also the case if -- the body has already been analyzed. Finally, if the unit enclosing - -- E is an instance, the instance body will be analyzed in any case, - -- and there is no need to add the enclosing unit (whose body might not - -- be available). + -- E is an instance, the instance body will be analyzed in any case. -- Library-level functions must be handled specially, because there is -- no enclosing package to retrieve. In this case, it is the body of @@ -497,13 +495,14 @@ package body Inline is Pack : constant Entity_Id := Get_Code_Unit_Entity (E); begin + Set_Is_Called (E); + if Pack = E then - Set_Is_Called (E); Inlined_Bodies.Increment_Last; Inlined_Bodies.Table (Inlined_Bodies.Last) := E; - elsif Ekind (Pack) = E_Package then - Set_Is_Called (E); + else + pragma Assert (Ekind (Pack) = E_Package); if Is_Generic_Instance (Pack) then null; @@ -606,6 +605,26 @@ package body Inline is end if; end Add_Inlined_Subprogram; + -------------------------------- + -- Add_Pending_Instantiation -- + -------------------------------- + + procedure Add_Pending_Instantiation (Inst : Node_Id; Act_Decl : Node_Id) is + begin + -- Capture the body of the generic instantiation along with its context + -- for later processing by Instantiate_Bodies. + + Pending_Instantiations.Append + ((Act_Decl => Act_Decl, + Config_Switches => Save_Config_Switches, + Current_Sem_Unit => Current_Sem_Unit, + Expander_Status => Expander_Active, + Inst_Node => Inst, + Local_Suppress_Stack_Top => Local_Suppress_Stack_Top, + Scope_Suppress => Scope_Suppress, + Warnings => Save_Warnings)); + end Add_Pending_Instantiation; + ------------------------ -- Add_Scope_To_Clean -- ------------------------ diff --git a/gcc/ada/inline.ads b/gcc/ada/inline.ads index 0e5a47e..e822ddc 100644 --- a/gcc/ada/inline.ads +++ b/gcc/ada/inline.ads @@ -143,6 +143,9 @@ package Inline is -- Add E's enclosing unit to Inlined_Bodies so that E can be subsequently -- retrieved and analyzed. N is the node giving rise to the call to E. + procedure Add_Pending_Instantiation (Inst : Node_Id; Act_Decl : Node_Id); + -- Add an entry in the table of generic bodies to be instantiated. + procedure Analyze_Inlined_Bodies; -- At end of compilation, analyze the bodies of all units that contain -- inlined subprograms that are actually called. diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 8b031b5..9f17494 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -1025,26 +1025,6 @@ package body Sem_Ch12 is raise Instantiation_Error; end Abandon_Instantiation; - -------------------------------- - -- Add_Pending_Instantiation -- - -------------------------------- - - procedure Add_Pending_Instantiation (Inst : Node_Id; Act_Decl : Node_Id) is - begin - -- Capture the body of the generic instantiation along with its context - -- for later processing by Instantiate_Bodies. - - Pending_Instantiations.Append - ((Act_Decl => Act_Decl, - Config_Switches => Save_Config_Switches, - Current_Sem_Unit => Current_Sem_Unit, - Expander_Status => Expander_Active, - Inst_Node => Inst, - Local_Suppress_Stack_Top => Local_Suppress_Stack_Top, - Scope_Suppress => Scope_Suppress, - Warnings => Save_Warnings)); - end Add_Pending_Instantiation; - ---------------------------------- -- Adjust_Inherited_Pragma_Sloc -- ---------------------------------- diff --git a/gcc/ada/sem_ch12.ads b/gcc/ada/sem_ch12.ads index 9c71368..f0b72f4 100644 --- a/gcc/ada/sem_ch12.ads +++ b/gcc/ada/sem_ch12.ads @@ -37,10 +37,6 @@ package Sem_Ch12 is procedure Analyze_Formal_Subprogram_Declaration (N : Node_Id); procedure Analyze_Formal_Package_Declaration (N : Node_Id); - procedure Add_Pending_Instantiation (Inst : Node_Id; Act_Decl : Node_Id); - -- Add an entry in the table of instance bodies that must be analyzed - -- when inlining requires its body or the body of a nested instance. - function Build_Function_Wrapper (Formal_Subp : Entity_Id; Actual_Subp : Entity_Id) return Node_Id; -- cgit v1.1 From 5b3b4d60896349500c8e338445570a1a6a7fcf61 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 13 Aug 2019 08:08:15 +0000 Subject: [Ada] Add GNAT.Branch_Prediction to Impunit 2019-08-13 Eric Botcazou gcc/ada/ * impunit.adb (Non_Imp_File_Names_95): Add GNAT.Branch_Prediction. From-SVN: r274354 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/impunit.adb | 1 + 2 files changed, 6 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9a97482..a6672d9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2019-08-13 Eric Botcazou + * impunit.adb (Non_Imp_File_Names_95): Add + GNAT.Branch_Prediction. + +2019-08-13 Eric Botcazou + * exp_ch6.adb: Remove with and use clauses for Sem_Ch12. (Expand_Call_Helper): Swap the back-end inlining case and the special front-end expansion case. In back-end inlining mode, do diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index 80857b3..4cf8535 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -241,6 +241,7 @@ package body Impunit is ("g-binenv", F), -- GNAT.Bind_Environment ("g-boubuf", F), -- GNAT.Bounded_Buffers ("g-boumai", F), -- GNAT.Bounded_Mailboxes + ("g-brapre", F), -- GNAT.Branch_Prediction ("g-bubsor", F), -- GNAT.Bubble_Sort ("g-busora", F), -- GNAT.Bubble_Sort_A ("g-busorg", F), -- GNAT.Bubble_Sort_G -- cgit v1.1 From 5efb7125030aab3e2622be6de7fbbb18ddfadc8f Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Tue, 13 Aug 2019 08:08:22 +0000 Subject: [Ada] Do not remove side-effects in an others_clause with function calls An aggregate can be handled by the backend if it consists of static constants of an elementary type, or null. If a component is a type conversion we must preanalyze and resolve it to determine whether the ultimate value is in one of these categories. Previously we did a full analysis and resolution of the expression for the component, which could lead to a removal of side-effects, which is semantically incorrect if the expression includes functions with side-effects (e.g. a call to a random generator). 2019-08-13 Ed Schonberg gcc/ada/ * exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Preanalyze expression, rather do a full analysis, to prevent unwanted removal of side effects which mask the intent of the expression. gcc/testsuite/ * gnat.dg/aggr27.adb: New testcase. From-SVN: r274355 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/exp_aggr.adb | 10 ++++++++++ 2 files changed, 16 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a6672d9..dfc30f2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-13 Ed Schonberg + + * exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Preanalyze + expression, rather do a full analysis, to prevent unwanted + removal of side effects which mask the intent of the expression. + 2019-08-13 Eric Botcazou * impunit.adb (Non_Imp_File_Names_95): Add diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 925d6ae..8668188 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -5321,6 +5321,16 @@ package body Exp_Aggr is return False; end if; + -- If the expression has side effects (e.g. contains calls with + -- potential side effects) reject as well. We only preanalyze the + -- expression to prevent the removal of intended side effects. + + Preanalyze_And_Resolve (Expr, Ctyp); + + if not Side_Effect_Free (Expr) then + return False; + end if; + -- The expression needs to be analyzed if True is returned Analyze_And_Resolve (Expr, Ctyp); -- cgit v1.1 From 5b15ac5f0506f3d9c1cf0913024e1c721521f7c0 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Tue, 13 Aug 2019 08:08:27 +0000 Subject: [Ada] Wrong dispatching call in type with aspect Implicit_Dereference When a record type with an an access to class-wide type discriminant has aspect Implicit_Dereference, and the discriminant is used as the controlling argument of a dispatching call, the compiler may generate wrong code to dispatch the call. 2019-08-13 Javier Miranda gcc/ada/ * sem_res.adb (Resolve_Selected_Component): When the type of the component is an access to a class-wide type and the type of the context is an access to a tagged type the relevant type is that of the component (since in such case we may need to generate implicit type conversions or dispatching calls). gcc/testsuite/ * gnat.dg/tagged3.adb, gnat.dg/tagged3_pkg.adb, gnat.dg/tagged3_pkg.ads: New testcase. From-SVN: r274356 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/sem_res.adb | 15 +++++++++++++++ 2 files changed, 23 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index dfc30f2..5e31330 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-08-13 Javier Miranda + + * sem_res.adb (Resolve_Selected_Component): When the type of the + component is an access to a class-wide type and the type of the + context is an access to a tagged type the relevant type is that + of the component (since in such case we may need to generate + implicit type conversions or dispatching calls). + 2019-08-13 Ed Schonberg * exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Preanalyze diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 7a9c85c..b27171f 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -10598,6 +10598,10 @@ package body Sem_Res is pragma Assert (Found); Resolve (P, It1.Typ); + + -- In general the expected type is the type of the context, not the + -- type of the candidate selected component. + Set_Etype (N, Typ); Set_Entity_With_Checks (S, Comp1); @@ -10610,6 +10614,17 @@ package body Sem_Res is if Ekind (Typ) = E_Anonymous_Access_Subprogram_Type then Set_Etype (N, Etype (Comp1)); + + -- When the type of the component is an access to a class-wide type + -- the relevant type is that of the component (since in such case we + -- may need to generate implicit type conversions or dispatching + -- calls). + + elsif Is_Access_Type (Typ) + and then not Is_Class_Wide_Type (Designated_Type (Typ)) + and then Is_Class_Wide_Type (Designated_Type (Etype (Comp1))) + then + Set_Etype (N, Etype (Comp1)); end if; else -- cgit v1.1 From 7f078d5b3e3ae2cdf527e6a163edd73238726a80 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 13 Aug 2019 08:08:32 +0000 Subject: [Ada] Fix spurious instantiation error on private record type This change was initially aimed at fixing a spurious instantiation error due to a disambiguation issue which happens when a generic unit with two formal type parameters is instantiated on a single actual type that is private. The compiler internally sets the Is_Generic_Actual_Type flag on the actual subtypes built for the instantiation in order to ease the disambiguation, but it would fail to set it on the full view if the subtypes are private. The change makes it so that the flag is properly set and reset on the full view in this case. But this uncovered an issue in Subtypes_Statically_Match, which was relying on a stalled Is_Generic_Actual_Type flag set on a full view outside of the instantiation to return a positive answer. This bypass was meant to solve an issue arising with a private discriminated record type whose completion is a discriminated record type itself derived from a private discriminated record type, which is used as actual type in an instantiation in another unit, and the instantiation is used in a child unit of the original unit. In this case, the private and full views of the generic actual type are swapped in the child unit, but there was a mismatch between the chain of full and underlying full views of the private discriminated record type and that of the generic actual type. This secondary issue is solved by avoiding to skip the full view in the preparation of the completion of the private subtype and by directly constraining the underlying full view of the full view of the base type instead of building an underlying full view from scratch. 2019-08-13 Eric Botcazou gcc/ada/ * sem_ch3.adb (Build_Underlying_Full_View): Delete. (Complete_Private_Subtype): Do not set the full view on the private subtype here. If the full base is itself derived from private, do not re-derive the parent type but instead constrain an existing underlying full view. (Prepare_Private_Subtype_Completion): Do not get to the underlying full view, if any. Set the full view on the private subtype here. (Process_Full_View): Likewise. * sem_ch12.adb (Check_Generic_Actuals): Also set Is_Generic_Actual_Type on the full view if the type of the actual is private. (Restore_Private_Views): Also reset Is_Generic_Actual_Type on the full view if the type of the actual is private. * sem_eval.adb (Subtypes_Statically_Match): Remove bypass for generic actual types. gcc/testsuite/ * gnat.dg/generic_inst10.adb, gnat.dg/generic_inst10_pkg.ads: New testcase. From-SVN: r274357 --- gcc/ada/ChangeLog | 19 ++++++ gcc/ada/sem_ch12.adb | 11 +++- gcc/ada/sem_ch3.adb | 162 ++++++--------------------------------------------- gcc/ada/sem_eval.adb | 12 +--- 4 files changed, 48 insertions(+), 156 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5e31330..dc039a6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2019-08-13 Eric Botcazou + + * sem_ch3.adb (Build_Underlying_Full_View): Delete. + (Complete_Private_Subtype): Do not set the full view on the + private subtype here. If the full base is itself derived from + private, do not re-derive the parent type but instead constrain + an existing underlying full view. + (Prepare_Private_Subtype_Completion): Do not get to the + underlying full view, if any. Set the full view on the private + subtype here. + (Process_Full_View): Likewise. + * sem_ch12.adb (Check_Generic_Actuals): Also set + Is_Generic_Actual_Type on the full view if the type of the + actual is private. + (Restore_Private_Views): Also reset Is_Generic_Actual_Type on + the full view if the type of the actual is private. + * sem_eval.adb (Subtypes_Statically_Match): Remove bypass for + generic actual types. + 2019-08-13 Javier Miranda * sem_res.adb (Resolve_Selected_Component): When the type of the diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 9f17494..f98f2fa 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -6804,7 +6804,12 @@ package body Sem_Ch12 is Check_Private_View (Subtype_Indication (Parent (E))); end if; - Set_Is_Generic_Actual_Type (E, True); + Set_Is_Generic_Actual_Type (E); + + if Is_Private_Type (E) and then Present (Full_View (E)) then + Set_Is_Generic_Actual_Type (Full_View (E)); + end if; + Set_Is_Hidden (E, False); Set_Is_Potentially_Use_Visible (E, In_Use (Instance)); @@ -14603,6 +14608,10 @@ package body Sem_Ch12 is null; else Set_Is_Generic_Actual_Type (E, False); + + if Is_Private_Type (E) and then Present (Full_View (E)) then + Set_Is_Generic_Actual_Type (Full_View (E), False); + end if; end if; -- An unusual case of aliasing: the actual may also be directly diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 645a024..ae8600c 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -232,18 +232,6 @@ package body Sem_Ch3 is -- Needs a more complete spec--what are the parameters exactly, and what -- exactly is the returned value, and how is Bound affected??? - procedure Build_Underlying_Full_View - (N : Node_Id; - Typ : Entity_Id; - Par : Entity_Id); - -- If the completion of a private type is itself derived from a private - -- type, or if the full view of a private subtype is itself private, the - -- back-end has no way to compute the actual size of this type. We build - -- an internal subtype declaration of the proper parent type to convey - -- this information. This extra mechanism is needed because a full - -- view cannot itself have a full view (it would get clobbered during - -- view exchanges). - procedure Check_Access_Discriminant_Requires_Limited (D : Node_Id; Loc : Node_Id); @@ -10447,111 +10435,6 @@ package body Sem_Ch3 is return New_Bound; end Build_Scalar_Bound; - -------------------------------- - -- Build_Underlying_Full_View -- - -------------------------------- - - procedure Build_Underlying_Full_View - (N : Node_Id; - Typ : Entity_Id; - Par : Entity_Id) - is - Loc : constant Source_Ptr := Sloc (N); - Subt : constant Entity_Id := - Make_Defining_Identifier - (Loc, New_External_Name (Chars (Typ), 'S')); - - Constr : Node_Id; - Indic : Node_Id; - C : Node_Id; - Id : Node_Id; - - procedure Set_Discriminant_Name (Id : Node_Id); - -- If the derived type has discriminants, they may rename discriminants - -- of the parent. When building the full view of the parent, we need to - -- recover the names of the original discriminants if the constraint is - -- given by named associations. - - --------------------------- - -- Set_Discriminant_Name -- - --------------------------- - - procedure Set_Discriminant_Name (Id : Node_Id) is - Disc : Entity_Id; - - begin - Set_Original_Discriminant (Id, Empty); - - if Has_Discriminants (Typ) then - Disc := First_Discriminant (Typ); - while Present (Disc) loop - if Chars (Disc) = Chars (Id) - and then Present (Corresponding_Discriminant (Disc)) - then - Set_Chars (Id, Chars (Corresponding_Discriminant (Disc))); - end if; - Next_Discriminant (Disc); - end loop; - end if; - end Set_Discriminant_Name; - - -- Start of processing for Build_Underlying_Full_View - - begin - if Nkind (N) = N_Full_Type_Declaration then - Constr := Constraint (Subtype_Indication (Type_Definition (N))); - - elsif Nkind (N) = N_Subtype_Declaration then - Constr := New_Copy_Tree (Constraint (Subtype_Indication (N))); - - elsif Nkind (N) = N_Component_Declaration then - Constr := - New_Copy_Tree - (Constraint (Subtype_Indication (Component_Definition (N)))); - - else - raise Program_Error; - end if; - - C := First (Constraints (Constr)); - while Present (C) loop - if Nkind (C) = N_Discriminant_Association then - Id := First (Selector_Names (C)); - while Present (Id) loop - Set_Discriminant_Name (Id); - Next (Id); - end loop; - end if; - - Next (C); - end loop; - - Indic := - Make_Subtype_Declaration (Loc, - Defining_Identifier => Subt, - Subtype_Indication => - Make_Subtype_Indication (Loc, - Subtype_Mark => New_Occurrence_Of (Par, Loc), - Constraint => New_Copy_Tree (Constr))); - - -- If this is a component subtype for an outer itype, it is not - -- a list member, so simply set the parent link for analysis: if - -- the enclosing type does not need to be in a declarative list, - -- neither do the components. - - if Is_List_Member (N) - and then Nkind (N) /= N_Component_Declaration - then - Insert_Before (N, Indic); - else - Set_Parent (Indic, Parent (N)); - end if; - - Analyze (Indic); - Set_Underlying_Full_View (Typ, Full_View (Subt)); - Set_Is_Underlying_Full_View (Full_View (Subt)); - end Build_Underlying_Full_View; - ------------------------------- -- Check_Abstract_Overriding -- ------------------------------- @@ -12471,7 +12354,6 @@ package body Sem_Ch3 is Set_Freeze_Node (Full, Empty); Set_Is_Frozen (Full, False); - Set_Full_View (Priv, Full); if Has_Discriminants (Full) then Set_Stored_Constraint_From_Discriminant_Constraint (Full); @@ -12492,26 +12374,24 @@ package body Sem_Ch3 is (Full, Related_Nod, Full_Base, Discriminant_Constraint (Priv)); -- If the full base is itself derived from private, build a congruent - -- subtype of its underlying type, for use by the back end. For a - -- constrained record component, the declaration cannot be placed on - -- the component list, but it must nevertheless be built an analyzed, to - -- supply enough information for Gigi to compute the size of component. + -- subtype of its underlying full view, for use by the back end. elsif Ekind (Full_Base) in Private_Kind - and then Is_Derived_Type (Full_Base) - and then Has_Discriminants (Full_Base) - and then (Ekind (Current_Scope) /= E_Record_Subtype) + and then Present (Underlying_Full_View (Full_Base)) then - if not Is_Itype (Priv) - and then - Nkind (Subtype_Indication (Parent (Priv))) = N_Subtype_Indication - then - Build_Underlying_Full_View - (Parent (Priv), Full, Etype (Full_Base)); - - elsif Nkind (Related_Nod) = N_Component_Declaration then - Build_Underlying_Full_View (Related_Nod, Full, Etype (Full_Base)); - end if; + declare + Underlying_Full_Base : constant Entity_Id + := Underlying_Full_View (Full_Base); + Underlying_Full : constant Entity_Id + := Make_Defining_Identifier (Sloc (Priv), Chars (Priv)); + begin + Set_Is_Itype (Underlying_Full); + Set_Associated_Node_For_Itype (Underlying_Full, Related_Nod); + Complete_Private_Subtype + (Priv, Underlying_Full, Underlying_Full_Base, Related_Nod); + Set_Underlying_Full_View (Full, Underlying_Full); + Set_Is_Underlying_Full_View (Underlying_Full); + end; elsif Is_Record_Type (Full_Base) then @@ -19928,20 +19808,12 @@ package body Sem_Ch3 is Related_Nod : Node_Id) is Id_B : constant Entity_Id := Base_Type (Id); - Full_B : Entity_Id := Full_View (Id_B); + Full_B : constant Entity_Id := Full_View (Id_B); Full : Entity_Id; begin if Present (Full_B) then - -- Get to the underlying full view if necessary - - if Is_Private_Type (Full_B) - and then Present (Underlying_Full_View (Full_B)) - then - Full_B := Underlying_Full_View (Full_B); - end if; - -- The Base_Type is already completed, we can complete the subtype -- now. We have to create a new entity with the same name, Thus we -- can't use Create_Itype. @@ -19950,6 +19822,7 @@ package body Sem_Ch3 is Set_Is_Itype (Full); Set_Associated_Node_For_Itype (Full, Related_Nod); Complete_Private_Subtype (Id, Full, Full_B, Related_Nod); + Set_Full_View (Id, Full); end if; -- The parent subtype may be private, but the base might not, in some @@ -20755,6 +20628,7 @@ package body Sem_Ch3 is end if; Complete_Private_Subtype (Full, Priv, Full_T, N); + Set_Full_View (Full, Priv); if Present (Priv_Scop) then Pop_Scope; diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index e417a07..78740b9 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -6031,17 +6031,7 @@ package body Sem_Eval is -- same base type. if Has_Discriminants (T1) /= Has_Discriminants (T2) then - -- A generic actual type is declared through a subtype declaration - -- and may have an inconsistent indication of the presence of - -- discriminants, so check the type it renames. - - if Is_Generic_Actual_Type (T1) - and then not Has_Discriminants (Etype (T1)) - and then not Has_Discriminants (T2) - then - return True; - - elsif In_Instance then + if In_Instance then if Is_Private_Type (T2) and then Present (Full_View (T2)) and then Has_Discriminants (Full_View (T2)) -- cgit v1.1 From cffb8f959c237b5af9e94ad4d0188a34acf5d910 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Tue, 13 Aug 2019 08:08:40 +0000 Subject: [Ada] Legality rule on ancestors of type extensions in generic bodies This patch adds an RM reference for the rule that in a generic body a type extension cannot have ancestors that are generic formal types. The patch also extends the check to interface progenitors that may appear in a derived type declaration or private extension declaration. 2019-08-13 Ed Schonberg gcc/ada/ * sem_ch3.adb (Check_Generic_Ancestor): New subprogram, aubsidiary to Build_Derived_Record_Type. to enforce the rule that a type extension declared in a generic body cznnot have an ancestor that is a generic formal (RM 3.9.1 (4/2)). The rule applies to all ancestors of the type, including interface progenitors. gcc/testsuite/ * gnat.dg/tagged4.adb: New testcase. From-SVN: r274358 --- gcc/ada/ChangeLog | 9 ++++ gcc/ada/sem_ch3.adb | 127 +++++++++++++++++++++++++++++++++------------------- 2 files changed, 90 insertions(+), 46 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index dc039a6..9ea478d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2019-08-13 Ed Schonberg + + * sem_ch3.adb (Check_Generic_Ancestor): New subprogram, + aubsidiary to Build_Derived_Record_Type. to enforce the rule + that a type extension declared in a generic body cznnot have an + ancestor that is a generic formal (RM 3.9.1 (4/2)). The rule + applies to all ancestors of the type, including interface + progenitors. + 2019-08-13 Eric Botcazou * sem_ch3.adb (Build_Underlying_Full_View): Delete. diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index ae8600c..c5655ee 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -8574,6 +8574,84 @@ package body Sem_Ch3 is -- An empty Discs list means that there were no constraints in the -- subtype indication or that there was an error processing it. + procedure Check_Generic_Ancestors; + -- In Ada 2005 (AI-344), the restriction that a derived tagged type + -- cannot be declared at a deeper level than its parent type is + -- removed. The check on derivation within a generic body is also + -- relaxed, but there's a restriction that a derived tagged type + -- cannot be declared in a generic body if it's derived directly + -- or indirectly from a formal type of that generic. This applies + -- to progenitors as well. + + ----------------------------- + -- Check_Generic_Ancestors -- + ----------------------------- + + procedure Check_Generic_Ancestors is + Ancestor_Type : Entity_Id; + Intf_List : List_Id; + Intf_Name : Node_Id; + + procedure Check_Ancestor; + -- For parent and progenitors. + + -------------------- + -- Check_Ancestor -- + -------------------- + + procedure Check_Ancestor is + begin + -- If the derived type does have a formal type as an ancestor + -- then it's an error if the derived type is declared within + -- the body of the generic unit that declares the formal type + -- in its generic formal part. It's sufficient to check whether + -- the ancestor type is declared inside the same generic body + -- as the derived type (such as within a nested generic spec), + -- in which case the derivation is legal. If the formal type is + -- declared outside of that generic body, then it's certain + -- that the derived type is declared within the generic body + -- of the generic unit declaring the formal type. + + if Is_Generic_Type (Ancestor_Type) + and then Enclosing_Generic_Body (Ancestor_Type) /= + Enclosing_Generic_Body (Derived_Type) + then + Error_Msg_NE + ("ancestor type& is formal type of enclosing" + & " generic unit (RM 3.9.1 (4/2))", + Indic, Ancestor_Type); + end if; + end Check_Ancestor; + + begin + if Nkind (N) = N_Private_Extension_Declaration then + Intf_List := Interface_List (N); + else + Intf_List := Interface_List (Type_Definition (N)); + end if; + + if Present (Enclosing_Generic_Body (Derived_Type)) then + Ancestor_Type := Parent_Type; + + while not Is_Generic_Type (Ancestor_Type) + and then Etype (Ancestor_Type) /= Ancestor_Type + loop + Ancestor_Type := Etype (Ancestor_Type); + end loop; + + Check_Ancestor; + + if Present (Intf_List) then + Intf_Name := First (Intf_List); + while Present (Intf_Name) loop + Ancestor_Type := Entity (Intf_Name); + Check_Ancestor; + Next (Intf_Name); + end loop; + end if; + end if; + end Check_Generic_Ancestors; + begin if Ekind (Parent_Type) = E_Record_Type_With_Private and then Present (Full_View (Parent_Type)) @@ -8680,7 +8758,8 @@ package body Sem_Ch3 is -- Indic can either be an N_Identifier if the subtype indication -- contains no constraint or an N_Subtype_Indication if the subtype - -- indication has a constraint. + -- indecation has a constraint. In either case it can include an + -- interface list. Indic := Subtype_Indication (Type_Def); Constraint_Present := (Nkind (Indic) = N_Subtype_Indication); @@ -8909,52 +8988,8 @@ package body Sem_Ch3 is Freeze_Before (N, Parent_Type); end if; - -- In Ada 2005 (AI-344), the restriction that a derived tagged type - -- cannot be declared at a deeper level than its parent type is - -- removed. The check on derivation within a generic body is also - -- relaxed, but there's a restriction that a derived tagged type - -- cannot be declared in a generic body if it's derived directly - -- or indirectly from a formal type of that generic. - if Ada_Version >= Ada_2005 then - if Present (Enclosing_Generic_Body (Derived_Type)) then - declare - Ancestor_Type : Entity_Id; - - begin - -- Check to see if any ancestor of the derived type is a - -- formal type. - - Ancestor_Type := Parent_Type; - while not Is_Generic_Type (Ancestor_Type) - and then Etype (Ancestor_Type) /= Ancestor_Type - loop - Ancestor_Type := Etype (Ancestor_Type); - end loop; - - -- If the derived type does have a formal type as an - -- ancestor, then it's an error if the derived type is - -- declared within the body of the generic unit that - -- declares the formal type in its generic formal part. It's - -- sufficient to check whether the ancestor type is declared - -- inside the same generic body as the derived type (such as - -- within a nested generic spec), in which case the - -- derivation is legal. If the formal type is declared - -- outside of that generic body, then it's guaranteed that - -- the derived type is declared within the generic body of - -- the generic unit declaring the formal type. - - if Is_Generic_Type (Ancestor_Type) - and then Enclosing_Generic_Body (Ancestor_Type) /= - Enclosing_Generic_Body (Derived_Type) - then - Error_Msg_NE - ("parent type of& must not be descendant of formal type" - & " of an enclosing generic body", - Indic, Derived_Type); - end if; - end; - end if; + Check_Generic_Ancestors; elsif Type_Access_Level (Derived_Type) /= Type_Access_Level (Parent_Type) -- cgit v1.1 From ed5786a74537bde38eba66b44fa0aa88b3d2ae89 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 13 Aug 2019 08:08:47 +0000 Subject: [Ada] Build full derivation for private concurrent type This extends the processing done for the derivation of private discriminated types to concurrent types, which is now required because this derivation is no longer redone when a subtype of the derived concurrent type is built. This increases the number of entities generated internally in the compiler but this case is sufficiently rare as not to be a real concern. 2019-08-13 Eric Botcazou gcc/ada/ * sem_ch3.adb (Build_Derived_Concurrent_Type): Add a couple of local variables and use them. When the derived type fully constrains the parent type, rewrite it as a subtype of an implicit (unconstrained) derived type instead of the other way around. (Copy_And_Build): Deal with concurrent types and use predicates. (Build_Derived_Private_Type): Build the full derivation if needed for concurrent types too. (Build_Derived_Record_Type): Add marker comment. (Complete_Private_Subtype): Use predicates. gcc/testsuite/ * gnat.dg/discr56.adb, gnat.dg/discr56.ads, gnat.dg/discr56_pkg1.adb, gnat.dg/discr56_pkg1.ads, gnat.dg/discr56_pkg2.ads: New testcase. From-SVN: r274359 --- gcc/ada/ChangeLog | 13 ++++++++ gcc/ada/sem_ch3.adb | 92 ++++++++++++++++++++++++++++++----------------------- 2 files changed, 65 insertions(+), 40 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9ea478d..c0c6c53 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2019-08-13 Eric Botcazou + + * sem_ch3.adb (Build_Derived_Concurrent_Type): Add a couple of + local variables and use them. When the derived type fully + constrains the parent type, rewrite it as a subtype of an + implicit (unconstrained) derived type instead of the other way + around. + (Copy_And_Build): Deal with concurrent types and use predicates. + (Build_Derived_Private_Type): Build the full derivation if + needed for concurrent types too. + (Build_Derived_Record_Type): Add marker comment. + (Complete_Private_Subtype): Use predicates. + 2019-08-13 Ed Schonberg * sem_ch3.adb (Check_Generic_Ancestor): New subprogram, diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index c5655ee..218aa0c 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -6831,7 +6831,9 @@ package body Sem_Ch3 is Parent_Type : Entity_Id; Derived_Type : Entity_Id) is - Loc : constant Source_Ptr := Sloc (N); + Loc : constant Source_Ptr := Sloc (N); + Def : constant Node_Id := Type_Definition (N); + Indic : constant Node_Id := Subtype_Indication (Def); Corr_Record : constant Entity_Id := Make_Temporary (Loc, 'C'); Corr_Decl : Node_Id; @@ -6842,8 +6844,7 @@ package body Sem_Ch3 is -- this case. Constraint_Present : constant Boolean := - Nkind (Subtype_Indication (Type_Definition (N))) = - N_Subtype_Indication; + Nkind (Indic) = N_Subtype_Indication; D_Constraint : Node_Id; New_Constraint : Elist_Id := No_Elist; @@ -6918,36 +6919,50 @@ package body Sem_Ch3 is Expand_To_Stored_Constraint (Parent_Type, Build_Discriminant_Constraints - (Parent_Type, - Subtype_Indication (Type_Definition (N)), True)); + (Parent_Type, Indic, True)); end if; End_Scope; elsif Constraint_Present then - -- Build constrained subtype, copying the constraint, and derive - -- from it to create a derived constrained type. + -- Build an unconstrained derived type and rewrite the derived type + -- as a subtype of this new base type. declare - Loc : constant Source_Ptr := Sloc (N); - Anon : constant Entity_Id := - Make_Defining_Identifier (Loc, - Chars => New_External_Name (Chars (Derived_Type), 'T')); - Decl : Node_Id; + Parent_Base : constant Entity_Id := Base_Type (Parent_Type); + New_Base : Entity_Id; + New_Decl : Node_Id; + New_Indic : Node_Id; begin - Decl := + New_Base := + Create_Itype (Ekind (Derived_Type), N, Derived_Type, 'B'); + + New_Decl := + Make_Full_Type_Declaration (Loc, + Defining_Identifier => New_Base, + Type_Definition => + Make_Derived_Type_Definition (Loc, + Abstract_Present => Abstract_Present (Def), + Limited_Present => Limited_Present (Def), + Subtype_Indication => + New_Occurrence_Of (Parent_Base, Loc))); + + Mark_Rewrite_Insertion (New_Decl); + Insert_Before (N, New_Decl); + Analyze (New_Decl); + + New_Indic := + Make_Subtype_Indication (Loc, + Subtype_Mark => New_Occurrence_Of (New_Base, Loc), + Constraint => Relocate_Node (Constraint (Indic))); + + Rewrite (N, Make_Subtype_Declaration (Loc, - Defining_Identifier => Anon, - Subtype_Indication => - New_Copy_Tree (Subtype_Indication (Type_Definition (N)))); - Insert_Before (N, Decl); - Analyze (Decl); + Defining_Identifier => Derived_Type, + Subtype_Indication => New_Indic)); - Rewrite (Subtype_Indication (Type_Definition (N)), - New_Occurrence_Of (Anon, Loc)); - Set_Analyzed (Derived_Type, False); Analyze (N); return; end; @@ -6978,10 +6993,7 @@ package body Sem_Ch3 is -- Verify that new discriminants are used to constrain old ones - D_Constraint := - First - (Constraints - (Constraint (Subtype_Indication (Type_Definition (N))))); + D_Constraint := First (Constraints (Constraint (Indic))); Old_Disc := First_Discriminant (Parent_Type); @@ -7662,14 +7674,15 @@ package body Sem_Ch3 is Full_Parent := Underlying_Full_View (Full_Parent); end if; - -- For record, access and most enumeration types, derivation from - -- the full view requires a fully-fledged declaration. In the other - -- cases, just use an itype. + -- For record, concurrent, access and most enumeration types, the + -- derivation from full view requires a fully-fledged declaration. + -- In the other cases, just use an itype. - if Ekind (Full_Parent) in Record_Kind - or else Ekind (Full_Parent) in Access_Kind + if Is_Record_Type (Full_Parent) + or else Is_Concurrent_Type (Full_Parent) + or else Is_Access_Type (Full_Parent) or else - (Ekind (Full_Parent) in Enumeration_Kind + (Is_Enumeration_Type (Full_Parent) and then not Is_Standard_Character_Type (Full_Parent) and then not Is_Generic_Type (Root_Type (Full_Parent))) then @@ -7698,7 +7711,7 @@ package body Sem_Ch3 is -- is now installed. Subprograms have been derived on the partial -- view, the completion does not derive them anew. - if Ekind (Full_Parent) in Record_Kind then + if Is_Record_Type (Full_Parent) then -- If parent type is tagged, the completion inherits the proper -- primitive operations. @@ -7900,12 +7913,10 @@ package body Sem_Ch3 is -- Build the full derivation if this is not the anonymous derived -- base type created by Build_Derived_Record_Type in the constrained -- case (see point 5. of its head comment) since we build it for the - -- derived subtype. And skip it for synchronized types altogether, as - -- gigi does not use these types directly. + -- derived subtype. if Present (Full_View (Parent_Type)) and then not Is_Itype (Derived_Type) - and then not Is_Concurrent_Type (Full_View (Parent_Type)) then declare Der_Base : constant Entity_Id := Base_Type (Derived_Type); @@ -8652,6 +8663,8 @@ package body Sem_Ch3 is end if; end Check_Generic_Ancestors; + -- Start of processing for Build_Derived_Record_Type + begin if Ekind (Parent_Type) = E_Record_Type_With_Private and then Present (Full_View (Parent_Type)) @@ -12265,10 +12278,9 @@ package body Sem_Ch3 is Save_Next_Entity := Next_Entity (Full); Save_Homonym := Homonym (Priv); - if Ekind (Full_Base) in Private_Kind - or else Ekind (Full_Base) in Protected_Kind - or else Ekind (Full_Base) in Record_Kind - or else Ekind (Full_Base) in Task_Kind + if Is_Private_Type (Full_Base) + or else Is_Record_Type (Full_Base) + or else Is_Concurrent_Type (Full_Base) then Copy_Node (Priv, Full); @@ -12411,7 +12423,7 @@ package body Sem_Ch3 is -- If the full base is itself derived from private, build a congruent -- subtype of its underlying full view, for use by the back end. - elsif Ekind (Full_Base) in Private_Kind + elsif Is_Private_Type (Full_Base) and then Present (Underlying_Full_View (Full_Base)) then declare -- cgit v1.1 From 519acab098317f6eab49b612e49d8fcc6562da8f Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 13 Aug 2019 08:08:52 +0000 Subject: [Ada] Remove unused component in record type The component has been unused for a while. No functional changes. 2019-08-13 Eric Botcazou gcc/ada/ * ali.ads (Linker_Option_Record): Remove Original_Pos component. * ali.adb (Scan_ALI): Do not set it. From-SVN: r274360 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/ali.adb | 3 --- gcc/ada/ali.ads | 14 +++++--------- 3 files changed, 10 insertions(+), 12 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c0c6c53..7a6d510 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2019-08-13 Eric Botcazou + * ali.ads (Linker_Option_Record): Remove Original_Pos component. + * ali.adb (Scan_ALI): Do not set it. + +2019-08-13 Eric Botcazou + * sem_ch3.adb (Build_Derived_Concurrent_Type): Add a couple of local variables and use them. When the derived type fully constrains the parent type, rewrite it as a subtype of an diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index feea73f..ab98104 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -3204,9 +3204,6 @@ package body ALI is Linker_Options.Table (Linker_Options.Last).Internal_File := Is_Internal_File_Name (F); - - Linker_Options.Table (Linker_Options.Last).Original_Pos := - Linker_Options.Last; end if; -- If there are notes present, scan them diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index fc6e592..22bf8a2 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -725,15 +725,11 @@ package ALI is -- Set True if the linker options are from an internal file. This is -- used to insert certain standard entries after all the user entries -- but before the entries from the run-time. - - Original_Pos : Positive; - -- Keep track of original position in the linker options table. This - -- is used to implement a stable sort when we sort the linker options - -- table. end record; - -- The indexes of active entries in this table range from 1 to the - -- value of Linker_Options.Last. The zero'th element is for sort call. + -- The indexes of active entries in this table range from 1 to + -- the value of Linker_Options.Last. The zero'th element is for + -- convenience if the table needs to be sorted. package Linker_Options is new Table.Table ( Table_Component_Type => Linker_Option_Record, @@ -770,8 +766,8 @@ package ALI is end record; -- The indexes of active entries in this table range from 1 to the - -- value of Linker_Options.Last. The zero'th element is for convenience - -- if the table needs to be sorted. + -- value of Notes.Last. The zero'th element is for convenience if + -- the table needs to be sorted. package Notes is new Table.Table ( Table_Component_Type => Notes_Record, -- cgit v1.1 From 4d732405bd91b54c196fdc38191f838bb01f23a6 Mon Sep 17 00:00:00 2001 From: Richard Sandiford Date: Tue, 13 Aug 2019 21:35:20 +0000 Subject: Use checking forms of DECL_FUNCTION_CODE (PR 91421) We were shoe-horning all built-in enumerations (including frontend and target-specific ones) into a field of type built_in_function. This was accessed as either an lvalue or an rvalue using DECL_FUNCTION_CODE. The obvious danger with this (as was noted by several ??? comments) is that the ranges have nothing to do with each other, and targets can easily have more built-in functions than generic code. But my patch to make the field bigger was the straw that finally made the problem visible. This patch therefore: - replaces the field with a plain unsigned int - turns DECL_FUNCTION_CODE into an rvalue-only accessor that checks that the function really is BUILT_IN_NORMAL - adds corresponding DECL_MD_FUNCTION_CODE and DECL_FE_FUNCTION_CODE accessors for BUILT_IN_MD and BUILT_IN_FRONTEND respectively - adds DECL_UNCHECKED_FUNCTION_CODE for places that need to access the underlying field (should be low-level code only) - adds new helpers for setting the built-in class and function code - makes DECL_BUILT_IN_CLASS an rvalue-only accessor too, since all assignments should go through the new helpers 2019-08-13 Richard Sandiford gcc/ PR middle-end/91421 * tree-core.h (function_decl::function_code): Change type to unsigned int. * tree.h (DECL_FUNCTION_CODE): Rename old definition to... (DECL_UNCHECKED_FUNCTION_CODE): ...this. (DECL_BUILT_IN_CLASS): Make an rvalue macro only. (DECL_FUNCTION_CODE): New function. Assert that the built-in class is BUILT_IN_NORMAL. (DECL_MD_FUNCTION_CODE, DECL_FE_FUNCTION_CODE): New functions. (set_decl_built_in_function, copy_decl_built_in_function): Likewise. (fndecl_built_in_p): Change the type of the "name" argument to unsigned int. * builtins.c (expand_builtin): Move DECL_FUNCTION_CODE use after check for DECL_BUILT_IN_CLASS. * cgraphclones.c (build_function_decl_skip_args): Use set_decl_built_in_function. * ipa-param-manipulation.c (ipa_modify_formal_parameters): Likewise. * ipa-split.c (split_function): Likewise. * langhooks.c (add_builtin_function_common): Likewise. * omp-simd-clone.c (simd_clone_create): Likewise. * tree-streamer-in.c (unpack_ts_function_decl_value_fields): Likewise. * config/darwin.c (darwin_init_cfstring_builtins): Likewise. (darwin_fold_builtin): Use DECL_MD_FUNCTION_CODE instead of DECL_FUNCTION_CODE. * fold-const.c (operand_equal_p): Compare DECL_UNCHECKED_FUNCTION_CODE instead of DECL_FUNCTION_CODE. * lto-streamer-out.c (hash_tree): Use DECL_UNCHECKED_FUNCTION_CODE instead of DECL_FUNCTION_CODE. * tree-streamer-out.c (pack_ts_function_decl_value_fields): Likewise. * print-tree.c (print_node): Use DECL_MD_FUNCTION_CODE when printing DECL_BUILT_IN_MD. Handle DECL_BUILT_IN_FRONTEND. * config/aarch64/aarch64-builtins.c (aarch64_expand_builtin) (aarch64_fold_builtin, aarch64_gimple_fold_builtin): Use DECL_MD_FUNCTION_CODE instead of DECL_FUNCTION_CODE. * config/aarch64/aarch64.c (aarch64_builtin_reciprocal): Likewise. * config/alpha/alpha.c (alpha_expand_builtin, alpha_fold_builtin): (alpha_gimple_fold_builtin): Likewise. * config/arc/arc.c (arc_expand_builtin): Likewise. * config/arm/arm-builtins.c (arm_expand_builtin): Likewise. * config/avr/avr-c.c (avr_resolve_overloaded_builtin): Likewise. * config/avr/avr.c (avr_expand_builtin, avr_fold_builtin): Likewise. * config/bfin/bfin.c (bfin_expand_builtin): Likewise. * config/c6x/c6x.c (c6x_expand_builtin): Likewise. * config/frv/frv.c (frv_expand_builtin): Likewise. * config/gcn/gcn.c (gcn_expand_builtin_1): Likewise. (gcn_expand_builtin): Likewise. * config/i386/i386-builtins.c (ix86_builtin_reciprocal): Likewise. (fold_builtin_cpu): Likewise. * config/i386/i386-expand.c (ix86_expand_builtin): Likewise. * config/i386/i386.c (ix86_fold_builtin): Likewise. (ix86_gimple_fold_builtin): Likewise. * config/ia64/ia64.c (ia64_fold_builtin): Likewise. (ia64_expand_builtin): Likewise. * config/iq2000/iq2000.c (iq2000_expand_builtin): Likewise. * config/mips/mips.c (mips_expand_builtin): Likewise. * config/msp430/msp430.c (msp430_expand_builtin): Likewise. * config/nds32/nds32-intrinsic.c (nds32_expand_builtin_impl): Likewise. * config/nios2/nios2.c (nios2_expand_builtin): Likewise. * config/nvptx/nvptx.c (nvptx_expand_builtin): Likewise. * config/pa/pa.c (pa_expand_builtin): Likewise. * config/pru/pru.c (pru_expand_builtin): Likewise. * config/riscv/riscv-builtins.c (riscv_expand_builtin): Likewise. * config/rs6000/rs6000-c.c (altivec_resolve_overloaded_builtin): Likewise. * config/rs6000/rs6000-call.c (htm_expand_builtin): Likewise. (altivec_expand_dst_builtin, altivec_expand_builtin): Likewise. (rs6000_gimple_fold_builtin, rs6000_expand_builtin): Likewise. * config/rs6000/rs6000.c (rs6000_builtin_md_vectorized_function) (rs6000_builtin_reciprocal): Likewise. * config/rx/rx.c (rx_expand_builtin): Likewise. * config/s390/s390-c.c (s390_resolve_overloaded_builtin): Likewise. * config/s390/s390.c (s390_expand_builtin): Likewise. * config/sh/sh.c (sh_expand_builtin): Likewise. * config/sparc/sparc.c (sparc_expand_builtin): Likewise. (sparc_fold_builtin): Likewise. * config/spu/spu-c.c (spu_resolve_overloaded_builtin): Likewise. * config/spu/spu.c (spu_expand_builtin): Likewise. * config/stormy16/stormy16.c (xstormy16_expand_builtin): Likewise. * config/tilegx/tilegx.c (tilegx_expand_builtin): Likewise. * config/tilepro/tilepro.c (tilepro_expand_builtin): Likewise. * config/xtensa/xtensa.c (xtensa_fold_builtin): Likewise. (xtensa_expand_builtin): Likewise. gcc/ada/ PR middle-end/91421 * gcc-interface/trans.c (gigi): Call set_decl_buillt_in_function. (Call_to_gnu): Use DECL_FE_FUNCTION_CODE instead of DECL_FUNCTION_CODE. gcc/c/ PR middle-end/91421 * c-decl.c (merge_decls): Use copy_decl_built_in_function. gcc/c-family/ PR middle-end/91421 * c-common.c (resolve_overloaded_builtin): Use copy_decl_built_in_function. gcc/cp/ PR middle-end/91421 * decl.c (duplicate_decls): Use copy_decl_built_in_function. * pt.c (declare_integer_pack): Use set_decl_built_in_function. gcc/d/ PR middle-end/91421 * intrinsics.cc (maybe_set_intrinsic): Use set_decl_built_in_function. gcc/jit/ PR middle-end/91421 * jit-playback.c (new_function): Use set_decl_built_in_function. gcc/lto/ PR middle-end/91421 * lto-common.c (compare_tree_sccs_1): Use DECL_UNCHECKED_FUNCTION_CODE instead of DECL_FUNCTION_CODE. * lto-symtab.c (lto_symtab_merge_p): Likewise. From-SVN: r274404 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/gcc-interface/trans.c | 9 ++++----- 2 files changed, 10 insertions(+), 5 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7a6d510..4d999a4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-13 Richard Sandiford + + PR middle-end/91421 + * gcc-interface/trans.c (gigi): Call set_decl_buillt_in_function. + (Call_to_gnu): Use DECL_FE_FUNCTION_CODE instead of DECL_FUNCTION_CODE. + 2019-08-13 Eric Botcazou * ali.ads (Linker_Option_Record): Remove Original_Pos component. diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index b484bc7..95991bd 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -493,8 +493,7 @@ gigi (Node_Id gnat_root, build_function_type_list (integer_type_node, jmpbuf_ptr_type, NULL_TREE), NULL_TREE, is_default, true, true, true, false, false, NULL, Empty); - DECL_BUILT_IN_CLASS (setjmp_decl) = BUILT_IN_NORMAL; - DECL_FUNCTION_CODE (setjmp_decl) = BUILT_IN_SETJMP; + set_decl_built_in_function (setjmp_decl, BUILT_IN_NORMAL, BUILT_IN_SETJMP); /* update_setjmp_buf updates a setjmp buffer from the current stack pointer address. */ @@ -503,8 +502,8 @@ gigi (Node_Id gnat_root, (get_identifier ("__builtin_update_setjmp_buf"), NULL_TREE, build_function_type_list (void_type_node, jmpbuf_ptr_type, NULL_TREE), NULL_TREE, is_default, true, true, true, false, false, NULL, Empty); - DECL_BUILT_IN_CLASS (update_setjmp_buf_decl) = BUILT_IN_NORMAL; - DECL_FUNCTION_CODE (update_setjmp_buf_decl) = BUILT_IN_UPDATE_SETJMP_BUF; + set_decl_built_in_function (update_setjmp_buf_decl, BUILT_IN_NORMAL, + BUILT_IN_UPDATE_SETJMP_BUF); /* Indicate that it never returns. */ ftype = build_function_type_list (void_type_node, @@ -5535,7 +5534,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, tree pred_cst = build_int_cst (integer_type_node, PRED_BUILTIN_EXPECT); enum internal_fn icode = IFN_BUILTIN_EXPECT; - switch (DECL_FUNCTION_CODE (gnu_subprog)) + switch (DECL_FE_FUNCTION_CODE (gnu_subprog)) { case BUILT_IN_EXPECT: break; -- cgit v1.1 From bc1f44ef8f87228591b7ecd74dac324812c0ff47 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Wed, 14 Aug 2019 09:44:21 +0000 Subject: [Ada] Minor refactoring in Einfo 2019-08-14 Piotr Trojanek gcc/ada/ * einfo.adb (Is_Generic_Actual_Subprogram): Replace repeated calls to Ekind with Ekind_In. From-SVN: r274445 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/einfo.adb | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4d999a4..937cecc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-14 Piotr Trojanek + + * einfo.adb (Is_Generic_Actual_Subprogram): Replace repeated + calls to Ekind with Ekind_In. + 2019-08-13 Richard Sandiford PR middle-end/91421 diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 4e5681d..0438c8e 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -2314,7 +2314,7 @@ package body Einfo is function Is_Generic_Actual_Subprogram (Id : E) return B is begin - pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure); + pragma Assert (Ekind_In (Id, E_Function, E_Procedure)); return Flag274 (Id); end Is_Generic_Actual_Subprogram; -- cgit v1.1 From 27de857e21ff577d5b478f3c98e4f3a8ca3b51b3 Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Wed, 14 Aug 2019 09:50:46 +0000 Subject: [Ada] Illegal selection of first object in a task type's body not detected The compiler was improperly allowing selection of an object declared within a task body when the prefix was of the task type, specifically in the case where the object was the very first declared in the body (selections of later body declarations were being flagged). The flag Is_Private_Op was only set at the point of the first "private" declaration of the type in cases where the first declaration's name didn't match the selector. 2019-08-14 Gary Dismukes gcc/ada/ * sem_ch4.adb (Analyze_Selected_Component): In the case where the prefix is of a concurrent type, and the selected entity matching the selector is the first private declaration of the type (such as the first local variable in a task's body), set Is_Private_Op. gcc/testsuite/ * gnat.dg/task5.adb: New testcase. From-SVN: r274446 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/sem_ch4.adb | 10 +++++++++- 2 files changed, 17 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 937cecc..8ad1983 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-08-14 Gary Dismukes + + * sem_ch4.adb (Analyze_Selected_Component): In the case where + the prefix is of a concurrent type, and the selected entity + matching the selector is the first private declaration of the + type (such as the first local variable in a task's body), set + Is_Private_Op. + 2019-08-14 Piotr Trojanek * einfo.adb (Is_Generic_Actual_Subprogram): Replace repeated diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 6272578..16614ed 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -4994,7 +4994,15 @@ package body Sem_Ch4 is if Comp = First_Private_Entity (Type_To_Use) then if Etype (Sel) /= Any_Type then - -- We have a candiate + -- If the first private entity's name matches, then treat + -- it as a private op: needed for the error check for + -- illegal selection of private entities further below. + + if Chars (Comp) = Chars (Sel) then + Is_Private_Op := True; + end if; + + -- We have a candidate, so exit the loop exit; -- cgit v1.1 From 4a6db9fd05bff1cd7a487eb87a4a0413c3c2301a Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 14 Aug 2019 09:50:51 +0000 Subject: [Ada] Small internal improvements to the inlining machinery No functional changes. 2019-08-14 Eric Botcazou gcc/ada/ * inline.adb (Add_Inlined_Body): Tweak comments. (List_Inlining_Info): Also list information about non-main units. From-SVN: r274447 --- gcc/ada/ChangeLog | 6 +++++ gcc/ada/inline.adb | 75 +++++++++++++++++++++++++++--------------------------- 2 files changed, 44 insertions(+), 37 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8ad1983..ff7de27 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-14 Eric Botcazou + + * inline.adb (Add_Inlined_Body): Tweak comments. + (List_Inlining_Info): Also list information about non-main + units. + 2019-08-14 Gary Dismukes * sem_ch4.adb (Analyze_Selected_Component): In the case where diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 3a3ec0c..aa8f7dd 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -481,12 +481,6 @@ package body Inline is end if; -- Find unit containing E, and add to list of inlined bodies if needed. - -- If the body is already present, no need to load any other unit. This - -- is the case for an initialization procedure, which appears in the - -- package declaration that contains the type. It is also the case if - -- the body has already been analyzed. Finally, if the unit enclosing - -- E is an instance, the instance body will be analyzed in any case. - -- Library-level functions must be handled specially, because there is -- no enclosing package to retrieve. In this case, it is the body of -- the function that will have to be loaded. @@ -504,6 +498,9 @@ package body Inline is else pragma Assert (Ekind (Pack) = E_Package); + -- If the unit containing E is an instance, then the instance body + -- will be analyzed in any case, see Sem_Ch12.Might_Inline_Subp. + if Is_Generic_Instance (Pack) then null; @@ -514,7 +511,7 @@ package body Inline is -- Do not inline it either if it is in the main unit. -- Extend the -gnatn2 processing to -gnatn1 for Inline_Always -- calls if the back-end takes care of inlining the call. - -- Note that Level in Inline_Package | Inline_Call here. + -- Note that Level is in Inline_Call | Inline_Packag here. elsif ((Level = Inline_Call and then Has_Pragma_Inline_Always (E) @@ -4350,7 +4347,7 @@ package body Inline is while Present (Elmt) loop Nod := Node (Elmt); - if In_Extended_Main_Code_Unit (Nod) then + if not In_Internal_Unit (Nod) then Count := Count + 1; if Count = 1 then @@ -4379,7 +4376,7 @@ package body Inline is while Present (Elmt) loop Nod := Node (Elmt); - if In_Extended_Main_Code_Unit (Nod) then + if not In_Internal_Unit (Nod) then Count := Count + 1; if Count = 1 then @@ -4407,22 +4404,24 @@ package body Inline is while Present (Elmt) loop Nod := Node (Elmt); - Count := Count + 1; + if not In_Internal_Unit (Nod) then + Count := Count + 1; - if Count = 1 then - Write_Str - ("List of inlined subprograms passed to the backend"); - Write_Eol; - end if; + if Count = 1 then + Write_Str + ("List of inlined subprograms passed to the backend"); + Write_Eol; + end if; - Write_Str (" "); - Write_Int (Count); - Write_Str (":"); - Write_Name (Chars (Nod)); - Write_Str (" ("); - Write_Location (Sloc (Nod)); - Write_Str (")"); - Output.Write_Eol; + Write_Str (" "); + Write_Int (Count); + Write_Str (":"); + Write_Name (Chars (Nod)); + Write_Str (" ("); + Write_Location (Sloc (Nod)); + Write_Str (")"); + Output.Write_Eol; + end if; Next_Elmt (Elmt); end loop; @@ -4437,22 +4436,24 @@ package body Inline is while Present (Elmt) loop Nod := Node (Elmt); - Count := Count + 1; + if not In_Internal_Unit (Nod) then + Count := Count + 1; - if Count = 1 then - Write_Str - ("List of subprograms that cannot be inlined by the backend"); - Write_Eol; - end if; + if Count = 1 then + Write_Str + ("List of subprograms that cannot be inlined by backend"); + Write_Eol; + end if; - Write_Str (" "); - Write_Int (Count); - Write_Str (":"); - Write_Name (Chars (Nod)); - Write_Str (" ("); - Write_Location (Sloc (Nod)); - Write_Str (")"); - Output.Write_Eol; + Write_Str (" "); + Write_Int (Count); + Write_Str (":"); + Write_Name (Chars (Nod)); + Write_Str (" ("); + Write_Location (Sloc (Nod)); + Write_Str (")"); + Output.Write_Eol; + end if; Next_Elmt (Elmt); end loop; -- cgit v1.1 From bab15911661814606d18639ef53597ea9a843afa Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Wed, 14 Aug 2019 09:50:55 +0000 Subject: [Ada] Fix failing assertions on SPARK elaboration Checking of SPARK elaboration rules may lead to assertion failures on a compiler built with assertions. Now fixed. There is no impact on compilation. 2019-08-14 Yannick Moy gcc/ada/ * sem_disp.adb (Check_Dispatching_Operation): Update assertion for the separate declarations created in GNATprove mode. * sem_disp.ads (Is_Overriding_Subprogram): Update comment. * sem_elab.adb (SPARK_Processor): Fix test for checking of overriding primitives. From-SVN: r274448 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/sem_disp.adb | 8 +++++++- gcc/ada/sem_disp.ads | 3 ++- gcc/ada/sem_elab.adb | 8 ++++++-- 4 files changed, 23 insertions(+), 4 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ff7de27..b8f85c4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-08-14 Yannick Moy + + * sem_disp.adb (Check_Dispatching_Operation): Update assertion + for the separate declarations created in GNATprove mode. + * sem_disp.ads (Is_Overriding_Subprogram): Update comment. + * sem_elab.adb (SPARK_Processor): Fix test for checking of + overriding primitives. + 2019-08-14 Eric Botcazou * inline.adb (Add_Inlined_Body): Tweak comments. diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 5deba18..ee8f443 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -1149,6 +1149,10 @@ package body Sem_Disp is -- overridden primitives. The wrappers include checks on these -- modified conditions. (AI12-113). + -- 5. Declarations built for subprograms without separate spec which + -- are eligible for inlining in GNATprove (inside + -- Sem_Ch6.Analyze_Subprogram_Body_Helper). + if Present (Old_Subp) and then Present (Overridden_Operation (Subp)) and then Is_Dispatching_Operation (Old_Subp) @@ -1168,7 +1172,9 @@ package body Sem_Disp is or else Get_TSS_Name (Subp) = TSS_Stream_Read or else Get_TSS_Name (Subp) = TSS_Stream_Write - or else Present (Contract (Overridden_Operation (Subp)))); + or else Present (Contract (Overridden_Operation (Subp))) + + or else GNATprove_Mode); Check_Controlling_Formals (Tagged_Type, Subp); Override_Dispatching_Operation (Tagged_Type, Old_Subp, Subp); diff --git a/gcc/ada/sem_disp.ads b/gcc/ada/sem_disp.ads index c3f4586..fd399a3 100644 --- a/gcc/ada/sem_disp.ads +++ b/gcc/ada/sem_disp.ads @@ -151,7 +151,8 @@ package Sem_Disp is -- Returns True if E is a null procedure that is an interface primitive function Is_Overriding_Subprogram (E : Entity_Id) return Boolean; - -- Returns True if E is an overriding subprogram + -- Returns True if E is an overriding subprogram and False otherwise, in + -- particular for an inherited subprogram. function Is_Tag_Indeterminate (N : Node_Id) return Boolean; -- Returns true if the expression N is tag-indeterminate. An expression diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 3145559..714a9f7 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -49,6 +49,7 @@ with Sem_Aux; use Sem_Aux; with Sem_Cat; use Sem_Cat; with Sem_Ch7; use Sem_Ch7; with Sem_Ch8; use Sem_Ch8; +with Sem_Disp; use Sem_Disp; with Sem_Prag; use Sem_Prag; with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; @@ -15233,9 +15234,12 @@ package body Sem_Elab is begin -- Nothing to do for predefined primitives because they are -- artifacts of tagged type expansion and cannot override source - -- primitives. + -- primitives. Nothing to do as well for inherited primitives as + -- the check concerns overridding ones. - if Is_Predefined_Dispatching_Operation (Prim) then + if Is_Predefined_Dispatching_Operation (Prim) + or else not Is_Overriding_Subprogram (Prim) + then return; end if; -- cgit v1.1 From cc248146c12018675f203f6be6b4d652765f0f76 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Wed, 14 Aug 2019 09:51:00 +0000 Subject: [Ada] Crash on precondition involving quantified expression This patch fixes a compiler abort on a precondition whose condition includes a quantified expression. 2019-08-14 Ed Schonberg gcc/ada/ * sem_util.adb (New_Copy_Tree, Visit_Entity): A quantified expression includes the implicit declaration of the loop parameter. When a quantified expression is copied during expansion, for example when building the precondition code from the generated pragma, a new loop parameter must be created for the new tree, to prevent duplicate declarations for the same symbol. gcc/testsuite/ * gnat.dg/predicate12.adb, gnat.dg/predicate12.ads: New testcase. From-SVN: r274449 --- gcc/ada/ChangeLog | 10 ++++++++++ gcc/ada/sem_util.adb | 26 +++++++++++++++++++++++++- 2 files changed, 35 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b8f85c4..e7bebe6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2019-08-14 Ed Schonberg + + * sem_util.adb (New_Copy_Tree, Visit_Entity): A quantified + expression includes the implicit declaration of the loop + parameter. When a quantified expression is copied during + expansion, for example when building the precondition code from + the generated pragma, a new loop parameter must be created for + the new tree, to prevent duplicate declarations for the same + symbol. + 2019-08-14 Yannick Moy * sem_disp.adb (Check_Dispatching_Operation): Update assertion diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 4f20eaa..db9233a 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -20799,16 +20799,27 @@ package body Sem_Util is -- this restriction leads to a performance penalty. -- ??? this list is flaky, and may hide dormant bugs + -- Should functions be included??? + + -- Loop parameters appear within quantified expressions and contain + -- an entity declaration that must be replaced when the expander is + -- active if the expression has been preanalyzed or analyzed. elsif not Ekind_In (Id, E_Block, E_Constant, E_Label, + E_Loop_Parameter, E_Procedure, E_Variable) and then not Is_Type (Id) then return; + elsif Ekind (Id) = E_Loop_Parameter + and then No (Etype (Condition (Parent (Parent (Id))))) + then + return; + -- Nothing to do when the entity was already visited elsif NCT_Tables_In_Use @@ -21081,7 +21092,14 @@ package body Sem_Util is begin pragma Assert (Nkind (N) not in N_Entity); - if Nkind (N) = N_Expression_With_Actions then + -- If the node is a quantified expression and expander is active, + -- it contains an implicit declaration that may require a new entity + -- when the condition has already been (pre)analyzed. + + if Nkind (N) = N_Expression_With_Actions + or else + (Nkind (N) = N_Quantified_Expression and then Expander_Active) + then EWA_Level := EWA_Level + 1; elsif EWA_Level > 0 @@ -21225,6 +21243,12 @@ package body Sem_Util is -- * Semantic fields of nodes such as First_Real_Statement must be -- updated to reference the proper replicated nodes. + -- Finally, quantified expressions contain an implicit delaration for + -- the bound variable. Given that quantified expressions appearing + -- in contracts are copied to create pragmas and eventually checking + -- procedures, a new bound variable must be created for each copy, to + -- prevent multiple declarations of the same symbol. + -- To meet all these demands, routine New_Copy_Tree is split into two -- phases. -- cgit v1.1 From d2d56bbae32be728ff82191b6d328e3a8d7c1530 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Wed, 14 Aug 2019 09:51:07 +0000 Subject: [Ada] Fix a recent ACATS regression (c552001) 2019-08-14 Javier Miranda gcc/ada/ * exp_aggr.adb (Is_CCG_Supported_Aggregate): Return False for arrays with bounds not known at compile time. From-SVN: r274450 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/exp_aggr.adb | 33 +++++++++++++++++++++++++++------ 2 files changed, 32 insertions(+), 6 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e7bebe6..72528d3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-14 Javier Miranda + + * exp_aggr.adb (Is_CCG_Supported_Aggregate): Return False for + arrays with bounds not known at compile time. + 2019-08-14 Ed Schonberg * sem_util.adb (New_Copy_Tree, Visit_Entity): A quantified diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 8668188..174da6e 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -7707,15 +7707,36 @@ package body Exp_Aggr is P := Parent (P); end loop; - -- Cases where aggregates are supported by the CCG backend + -- Check cases where aggregates are supported by the CCG backend if Nkind (P) = N_Object_Declaration then - return True; + declare + P_Typ : constant Entity_Id := Etype (Defining_Identifier (P)); - elsif Nkind (P) = N_Qualified_Expression - and then Nkind_In (Parent (P), N_Allocator, N_Object_Declaration) - then - return True; + begin + if Is_Record_Type (P_Typ) then + return True; + else + return Compile_Time_Known_Bounds (P_Typ); + end if; + end; + + elsif Nkind (P) = N_Qualified_Expression then + if Nkind (Parent (P)) = N_Object_Declaration then + declare + P_Typ : constant Entity_Id := + Etype (Defining_Identifier (Parent (P))); + begin + if Is_Record_Type (P_Typ) then + return True; + else + return Compile_Time_Known_Bounds (P_Typ); + end if; + end; + + elsif Nkind (Parent (P)) = N_Allocator then + return True; + end if; end if; return False; -- cgit v1.1 From ebe1a04f30e07c84264da571ac4da003e8c4bc05 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 14 Aug 2019 09:51:12 +0000 Subject: [Ada] Fix discrepancy in mechanism tracking private and full views This fixes a discrepancy in the mechanism tracking the private and full views of entities when entering and leaving scopes. This mechanism records private entities that are dependent on other private entities, so that the exchange done on entering and leaving scopes can be propagated. The propagation is done recursively on entering child units, but it was not done recursively on leaving them, which would leave the dependency chains in a uncertain state in this case. That's mostly visible when inlining across units is enabled for code involving a lot of generic units. 2019-08-14 Eric Botcazou gcc/ada/ * sem_ch7.adb (Install_Private_Declarations) : Do not rely solely on the Is_Child_Unit flag on the unit to recurse. (Uninstall_Declarations) : New function. Use it to recurse on the private dependent entities for child units. gcc/testsuite/ * gnat.dg/inline18.adb, gnat.dg/inline18.ads, gnat.dg/inline18_gen1-inner_g.ads, gnat.dg/inline18_gen1.adb, gnat.dg/inline18_gen1.ads, gnat.dg/inline18_gen2.adb, gnat.dg/inline18_gen2.ads, gnat.dg/inline18_gen3.adb, gnat.dg/inline18_gen3.ads, gnat.dg/inline18_pkg1.adb, gnat.dg/inline18_pkg1.ads, gnat.dg/inline18_pkg2-child.ads, gnat.dg/inline18_pkg2.ads: New testcase. From-SVN: r274451 --- gcc/ada/ChangeLog | 9 +++++ gcc/ada/sem_ch7.adb | 106 +++++++++++++++++++++++++++++++++++++--------------- 2 files changed, 84 insertions(+), 31 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 72528d3..b693032 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2019-08-14 Eric Botcazou + + * sem_ch7.adb (Install_Private_Declarations) + : Do not rely solely on the + Is_Child_Unit flag on the unit to recurse. + (Uninstall_Declarations) : New + function. Use it to recurse on the private dependent entities + for child units. + 2019-08-14 Javier Miranda * exp_aggr.adb (Is_CCG_Supported_Aggregate): Return False for diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index e0d20ef..f7998c0 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -2261,13 +2261,14 @@ package body Sem_Ch7 is procedure Swap_Private_Dependents (Priv_Deps : Elist_Id); -- When the full view of a private type is made available, we do the -- same for its private dependents under proper visibility conditions. - -- When compiling a grandchild unit this needs to be done recursively. + -- When compiling a child unit this needs to be done recursively. ----------------------------- -- Swap_Private_Dependents -- ----------------------------- procedure Swap_Private_Dependents (Priv_Deps : Elist_Id) is + Cunit : Entity_Id; Deps : Elist_Id; Priv : Entity_Id; Priv_Elmt : Elmt_Id; @@ -2285,6 +2286,7 @@ package body Sem_Ch7 is if Present (Full_View (Priv)) and then Is_Visible_Dependent (Priv) then if Is_Private_Type (Priv) then + Cunit := Cunit_Entity (Current_Sem_Unit); Deps := Private_Dependents (Priv); Is_Priv := True; else @@ -2312,11 +2314,14 @@ package body Sem_Ch7 is Set_Is_Potentially_Use_Visible (Priv, Is_Potentially_Use_Visible (Node (Priv_Elmt))); - -- Within a child unit, recurse, except in generic child unit, - -- which (unfortunately) handle private_dependents separately. + -- Recurse for child units, except in generic child units, + -- which unfortunately handle private_dependents separately. + -- Note that the current unit may not have been analyzed, + -- for example a package body, so we cannot rely solely on + -- the Is_Child_Unit flag, but that's only an optimization. if Is_Priv - and then Is_Child_Unit (Cunit_Entity (Current_Sem_Unit)) + and then (No (Etype (Cunit)) or else Is_Child_Unit (Cunit)) and then not Is_Empty_Elmt_List (Deps) and then not Inside_A_Generic then @@ -2701,13 +2706,16 @@ package body Sem_Ch7 is Decl : constant Node_Id := Unit_Declaration_Node (P); Id : Entity_Id; Full : Entity_Id; - Priv_Elmt : Elmt_Id; - Priv_Sub : Entity_Id; procedure Preserve_Full_Attributes (Priv : Entity_Id; Full : Entity_Id); -- Copy to the private declaration the attributes of the full view that -- need to be available for the partial view also. + procedure Swap_Private_Dependents (Priv_Deps : Elist_Id); + -- When the full view of a private type is made unavailable, we do the + -- same for its private dependents under proper visibility conditions. + -- When compiling a child unit this needs to be done recursively. + function Type_In_Use (T : Entity_Id) return Boolean; -- Check whether type or base type appear in an active use_type clause @@ -2826,6 +2834,66 @@ package body Sem_Ch7 is end if; end Preserve_Full_Attributes; + ----------------------------- + -- Swap_Private_Dependents -- + ----------------------------- + + procedure Swap_Private_Dependents (Priv_Deps : Elist_Id) is + Cunit : Entity_Id; + Deps : Elist_Id; + Priv : Entity_Id; + Priv_Elmt : Elmt_Id; + Is_Priv : Boolean; + + begin + Priv_Elmt := First_Elmt (Priv_Deps); + while Present (Priv_Elmt) loop + Priv := Node (Priv_Elmt); + + -- Before we do the swap, we verify the presence of the Full_View + -- field, which may be empty due to a swap by a previous call to + -- End_Package_Scope (e.g. from the freezing mechanism). + + if Present (Full_View (Priv)) then + if Is_Private_Type (Priv) then + Cunit := Cunit_Entity (Current_Sem_Unit); + Deps := Private_Dependents (Priv); + Is_Priv := True; + else + Is_Priv := False; + end if; + + if Scope (Priv) = P + or else not In_Open_Scopes (Scope (Priv)) + then + Set_Is_Immediately_Visible (Priv, False); + end if; + + if Is_Visible_Dependent (Priv) then + Preserve_Full_Attributes (Priv, Full_View (Priv)); + Replace_Elmt (Priv_Elmt, Full_View (Priv)); + Exchange_Declarations (Priv); + + -- Recurse for child units, except in generic child units, + -- which unfortunately handle private_dependents separately. + -- Note that the current unit may not have been analyzed, + -- for example a package body, so we cannot rely solely on + -- the Is_Child_Unit flag, but that's only an optimization. + + if Is_Priv + and then (No (Etype (Cunit)) or else Is_Child_Unit (Cunit)) + and then not Is_Empty_Elmt_List (Deps) + and then not Inside_A_Generic + then + Swap_Private_Dependents (Deps); + end if; + end if; + end if; + + Next_Elmt (Priv_Elmt); + end loop; + end Swap_Private_Dependents; + ----------------- -- Type_In_Use -- ----------------- @@ -3077,31 +3145,7 @@ package body Sem_Ch7 is -- were compiled in this scope, or installed previously -- by Install_Private_Declarations. - -- Before we do the swap, we verify the presence of the Full_View - -- field which may be empty due to a swap by a previous call to - -- End_Package_Scope (e.g. from the freezing mechanism). - - Priv_Elmt := First_Elmt (Private_Dependents (Id)); - while Present (Priv_Elmt) loop - Priv_Sub := Node (Priv_Elmt); - - if Present (Full_View (Priv_Sub)) then - if Scope (Priv_Sub) = P - or else not In_Open_Scopes (Scope (Priv_Sub)) - then - Set_Is_Immediately_Visible (Priv_Sub, False); - end if; - - if Is_Visible_Dependent (Priv_Sub) then - Preserve_Full_Attributes - (Priv_Sub, Full_View (Priv_Sub)); - Replace_Elmt (Priv_Elmt, Full_View (Priv_Sub)); - Exchange_Declarations (Priv_Sub); - end if; - end if; - - Next_Elmt (Priv_Elmt); - end loop; + Swap_Private_Dependents (Private_Dependents (Id)); -- Now restore the type itself to its private view -- cgit v1.1 From 9d7921310e5a265f0db62e45a881c266b8e4bec1 Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Wed, 14 Aug 2019 09:51:16 +0000 Subject: [Ada] Fix spurious ownership error in GNATprove Like Is_Path_Expression, function Is_Subpath_Expression should consider the possibility that the subpath is a type conversion or type qualification over the actual subpath node. This avoids spurious ownership errors in GNATprove. There is no impact on compilation. 2019-08-14 Yannick Moy gcc/ada/ * sem_spark.adb (Is_Subpath_Expression): Take into account conversion and qualification. From-SVN: r274452 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem_spark.adb | 9 ++++++++- 2 files changed, 13 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b693032..250d174 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-14 Yannick Moy + + * sem_spark.adb (Is_Subpath_Expression): Take into account + conversion and qualification. + 2019-08-14 Eric Botcazou * sem_ch7.adb (Install_Private_Declarations) diff --git a/gcc/ada/sem_spark.adb b/gcc/ada/sem_spark.adb index a60a6cb..542f694 100644 --- a/gcc/ada/sem_spark.adb +++ b/gcc/ada/sem_spark.adb @@ -4266,6 +4266,12 @@ package body Sem_SPARK is is begin return Is_Path_Expression (Expr, Is_Traversal) + + or else (Nkind_In (Expr, N_Qualified_Expression, + N_Type_Conversion, + N_Unchecked_Type_Conversion) + and then Is_Subpath_Expression (Expression (Expr))) + or else (Nkind (Expr) = N_Attribute_Reference and then (Get_Attribute_Id (Attribute_Name (Expr)) = @@ -4276,7 +4282,8 @@ package body Sem_SPARK is or else Get_Attribute_Id (Attribute_Name (Expr)) = Attribute_Image)) - or else Nkind (Expr) = N_Op_Concat; + + or else Nkind (Expr) = N_Op_Concat; end Is_Subpath_Expression; --------------------------- -- cgit v1.1 From 05b77088c086863aa3e5c0456b9a0c0075e05a6d Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Wed, 14 Aug 2019 09:51:21 +0000 Subject: [Ada] Check SPARK restriction on Old/Loop_Entry with pointers --#! r336866 --#! no-mail SPARK RM rule 3.10(14) restricts the use of Old and Loop_Entry attributes on prefixes of an owning or observing type (i.e. a type with access inside). There is no impact on compilation. 2019-08-14 Yannick Moy gcc/ada/ * sem_spark.adb (Check_Old_Loop_Entry): New procedure to check correct use of Old and Loop_Entry. (Check_Node): Check subprogram contracts. (Check_Pragma): Check Loop_Variant. (Check_Safe_Pointers): Apply checking to library-level subprogram declarations as well, in order to check their contract. From-SVN: r274453 --- gcc/ada/ChangeLog | 10 ++++ gcc/ada/sem_spark.adb | 125 ++++++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 130 insertions(+), 5 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 250d174..cef5e8c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,15 @@ 2019-08-14 Yannick Moy + * sem_spark.adb (Check_Old_Loop_Entry): New procedure to check + correct use of Old and Loop_Entry. + (Check_Node): Check subprogram contracts. + (Check_Pragma): Check Loop_Variant. + (Check_Safe_Pointers): Apply checking to library-level + subprogram declarations as well, in order to check their + contract. + +2019-08-14 Yannick Moy + * sem_spark.adb (Is_Subpath_Expression): Take into account conversion and qualification. diff --git a/gcc/ada/sem_spark.adb b/gcc/ada/sem_spark.adb index 542f694..37c6b4d 100644 --- a/gcc/ada/sem_spark.adb +++ b/gcc/ada/sem_spark.adb @@ -663,6 +663,9 @@ package body Sem_SPARK is procedure Check_Node (N : Node_Id); -- Main traversal procedure to check safe pointer usage + procedure Check_Old_Loop_Entry (N : Node_Id); + -- Check SPARK RM 3.10(14) regarding 'Old and 'Loop_Entry + procedure Check_Package_Body (Pack : Node_Id); procedure Check_Package_Spec (Pack : Node_Id); @@ -2583,6 +2586,43 @@ package body Sem_SPARK is ---------------- procedure Check_Node (N : Node_Id) is + + procedure Check_Subprogram_Contract (N : Node_Id); + -- Check the postcondition-like contracts for use of 'Old + + ------------------------------- + -- Check_Subprogram_Contract -- + ------------------------------- + + procedure Check_Subprogram_Contract (N : Node_Id) is + begin + if Nkind (N) = N_Subprogram_Declaration + or else Acts_As_Spec (N) + then + declare + E : constant Entity_Id := Unique_Defining_Entity (N); + Post : constant Node_Id := + Get_Pragma (E, Pragma_Postcondition); + Cases : constant Node_Id := + Get_Pragma (E, Pragma_Contract_Cases); + begin + Check_Old_Loop_Entry (Post); + Check_Old_Loop_Entry (Cases); + end; + + elsif Nkind (N) = N_Subprogram_Body then + declare + E : constant Entity_Id := Defining_Entity (N); + Ref_Post : constant Node_Id := + Get_Pragma (E, Pragma_Refined_Post); + begin + Check_Old_Loop_Entry (Ref_Post); + end; + end if; + end Check_Subprogram_Contract; + + -- Start of processing for Check_Node + begin case Nkind (N) is when N_Declaration => @@ -2602,14 +2642,17 @@ package body Sem_SPARK is Check_Package_Body (N); end if; - when N_Subprogram_Body - | N_Entry_Body - | N_Task_Body - => + when N_Subprogram_Body => if not Is_Generic_Unit (Unique_Defining_Entity (N)) then + Check_Subprogram_Contract (N); Check_Callable_Body (N); end if; + when N_Entry_Body + | N_Task_Body + => + Check_Callable_Body (N); + when N_Protected_Body => Check_List (Declarations (N)); @@ -2622,6 +2665,9 @@ package body Sem_SPARK is when N_Pragma => Check_Pragma (N); + when N_Subprogram_Declaration => + Check_Subprogram_Contract (N); + -- Ignored constructs for pointer checking when N_Abstract_Subprogram_Declaration @@ -2655,7 +2701,6 @@ package body Sem_SPARK is | N_Procedure_Instantiation | N_Raise_xxx_Error | N_Record_Representation_Clause - | N_Subprogram_Declaration | N_Subprogram_Renaming_Declaration | N_Task_Type_Declaration | N_Use_Package_Clause @@ -2677,6 +2722,65 @@ package body Sem_SPARK is end case; end Check_Node; + -------------------------- + -- Check_Old_Loop_Entry -- + -------------------------- + + procedure Check_Old_Loop_Entry (N : Node_Id) is + + function Check_Attribute (N : Node_Id) return Traverse_Result; + + --------------------- + -- Check_Attribute -- + --------------------- + + function Check_Attribute (N : Node_Id) return Traverse_Result is + Attr_Id : Attribute_Id; + Aname : Name_Id; + Pref : Node_Id; + + begin + if Nkind (N) = N_Attribute_Reference then + Attr_Id := Get_Attribute_Id (Attribute_Name (N)); + Aname := Attribute_Name (N); + + if Attr_Id = Attribute_Old + or else Attr_Id = Attribute_Loop_Entry + then + Pref := Prefix (N); + + if Is_Deep (Etype (Pref)) then + if Nkind (Pref) /= N_Function_Call then + if Emit_Messages then + Error_Msg_Name_1 := Aname; + Error_Msg_N + ("prefix of % attribute must be a function call " + & "(SPARK RM 3.10(14))", Pref); + end if; + + elsif Is_Traversal_Function_Call (Pref) then + if Emit_Messages then + Error_Msg_Name_1 := Aname; + Error_Msg_N + ("prefix of % attribute should not call a traversal " + & "function (SPARK RM 3.10(14))", Pref); + end if; + end if; + end if; + end if; + end if; + + return OK; + end Check_Attribute; + + procedure Check_All is new Traverse_Proc (Check_Attribute); + + -- Start of processing for Check_Old_Loop_Entry + + begin + Check_All (N); + end Check_Old_Loop_Entry; + ------------------------ -- Check_Package_Body -- ------------------------ @@ -2869,8 +2973,18 @@ package body Sem_SPARK is Expr : constant Node_Id := Expression (Arg2); begin Check_Expression (Expr, Read); + + -- Prefix of Loop_Entry should be checked inside any assertion + -- where it may appear. + + Check_Old_Loop_Entry (Expr); end; + -- Prefix of Loop_Entry should be checked inside a Loop_Variant + + when Pragma_Loop_Variant => + Check_Old_Loop_Entry (Prag); + -- There is no need to check contracts, as these can only access -- inputs and outputs of the subprogram. Inputs are checked -- independently for R permission. Outputs are checked @@ -2963,6 +3077,7 @@ package body Sem_SPARK is when N_Package_Body | N_Package_Declaration + | N_Subprogram_Declaration | N_Subprogram_Body => declare -- cgit v1.1 From 1384d88fa9d7bb81b3e37568622f6839cd28be26 Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Wed, 14 Aug 2019 09:51:25 +0000 Subject: [Ada] Expose part of ownership checking for use in GNATprove GNATprove needs to be able to call a subset of the ownership legality rules from marking. This is provided by a new function Sem_SPARK.Is_Legal. There is no impact on compilation. 2019-08-14 Yannick Moy gcc/ada/ * sem_spark.adb, sem_spark.ads (Is_Legal): New function exposed for use in GNATprove, to test legality rules not related to permissions. (Check_Declaration_Legality): Extract the part of Check_Declaration that checks rules not related to permissions. (Check_Declaration): Call the new Check_Declaration_Legality. (Check_Type_Legality): Rename of Check_Type. Introduce parameters to force or not checking, and update a flag detecting illegalities. (Check_Node): Ignore attribute references in statement position. From-SVN: r274454 --- gcc/ada/ChangeLog | 13 ++++ gcc/ada/sem_spark.adb | 212 ++++++++++++++++++++++++++++++++++++++++++-------- gcc/ada/sem_spark.ads | 6 ++ 3 files changed, 198 insertions(+), 33 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index cef5e8c..1d13947 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,18 @@ 2019-08-14 Yannick Moy + * sem_spark.adb, sem_spark.ads (Is_Legal): New function exposed + for use in GNATprove, to test legality rules not related to + permissions. + (Check_Declaration_Legality): Extract the part of + Check_Declaration that checks rules not related to permissions. + (Check_Declaration): Call the new Check_Declaration_Legality. + (Check_Type_Legality): Rename of Check_Type. Introduce + parameters to force or not checking, and update a flag detecting + illegalities. + (Check_Node): Ignore attribute references in statement position. + +2019-08-14 Yannick Moy + * sem_spark.adb (Check_Old_Loop_Entry): New procedure to check correct use of Old and Loop_Entry. (Check_Node): Check subprogram contracts. diff --git a/gcc/ada/sem_spark.adb b/gcc/ada/sem_spark.adb index 37c6b4d..b0686b7 100644 --- a/gcc/ada/sem_spark.adb +++ b/gcc/ada/sem_spark.adb @@ -637,6 +637,14 @@ package body Sem_SPARK is procedure Check_Declaration (Decl : Node_Id); + procedure Check_Declaration_Legality + (Decl : Node_Id; + Force : Boolean; + Legal : in out Boolean); + -- Check the legality of declaration Decl regarding rules not related to + -- permissions. Update Legal to False if a rule is violated. Issue an + -- error message if Force is True and Emit_Messages returns True. + procedure Check_Expression (Expr : Node_Id; Mode : Extended_Checking_Mode); pragma Precondition (Nkind_In (Expr, N_Index_Or_Discriminant_Constraint, N_Range_Constraint, @@ -686,7 +694,10 @@ package body Sem_SPARK is procedure Check_Statement (Stmt : Node_Id); - procedure Check_Type (Typ : Entity_Id); + procedure Check_Type_Legality + (Typ : Entity_Id; + Force : Boolean; + Legal : in out Boolean); -- Check that type Typ is either not deep, or that it is an observing or -- owning type according to SPARK RM 3.10 @@ -1138,11 +1149,12 @@ package body Sem_SPARK is Expr_Root : Entity_Id; Perm : Perm_Kind; Status : Error_Status; + Dummy : Boolean := True; -- Start of processing for Check_Assignment begin - Check_Type (Target_Typ); + Check_Type_Legality (Target_Typ, Force => True, Legal => Dummy); if Is_Anonymous_Access_Type (Target_Typ) then Check_Source_Of_Borrow_Or_Observe (Expr, Status); @@ -1410,11 +1422,18 @@ package body Sem_SPARK is Target : constant Entity_Id := Defining_Identifier (Decl); Target_Typ : constant Node_Id := Etype (Target); Expr : Node_Id; + Dummy : Boolean := True; begin + -- Start with legality rules not related to permissions + + Check_Declaration_Legality (Decl, Force => True, Legal => Dummy); + + -- Now check permission-related legality rules + case N_Declaration'(Nkind (Decl)) is when N_Full_Type_Declaration => - Check_Type (Target); + null; -- ??? What about component declarations with defaults. @@ -1424,7 +1443,105 @@ package body Sem_SPARK is when N_Object_Declaration => Expr := Expression (Decl); - Check_Type (Target_Typ); + if Present (Expr) then + Check_Assignment (Target => Target, + Expr => Expr); + end if; + + if Is_Deep (Target_Typ) then + declare + Tree : constant Perm_Tree_Access := + new Perm_Tree_Wrapper' + (Tree => + (Kind => Entire_Object, + Is_Node_Deep => True, + Explanation => Decl, + Permission => Read_Write, + Children_Permission => Read_Write)); + begin + Set (Current_Perm_Env, Target, Tree); + end; + end if; + + when N_Iterator_Specification => + null; + + when N_Loop_Parameter_Specification => + null; + + -- Checking should not be called directly on these nodes + + when N_Function_Specification + | N_Entry_Declaration + | N_Procedure_Specification + | N_Component_Declaration + => + raise Program_Error; + + -- Ignored constructs for pointer checking + + when N_Formal_Object_Declaration + | N_Formal_Type_Declaration + | N_Incomplete_Type_Declaration + | N_Private_Extension_Declaration + | N_Private_Type_Declaration + | N_Protected_Type_Declaration + => + null; + + -- The following nodes are rewritten by semantic analysis + + when N_Expression_Function => + raise Program_Error; + end case; + end Check_Declaration; + + -------------------------------- + -- Check_Declaration_Legality -- + -------------------------------- + + procedure Check_Declaration_Legality + (Decl : Node_Id; + Force : Boolean; + Legal : in out Boolean) + is + function Original_Emit_Messages return Boolean renames Emit_Messages; + + function Emit_Messages return Boolean; + -- Local wrapper around generic formal parameter Emit_Messages, to + -- check the value of parameter Force before calling the original + -- Emit_Messages, and setting Legal to False. + + ------------------- + -- Emit_Messages -- + ------------------- + + function Emit_Messages return Boolean is + begin + Legal := False; + return Force and then Original_Emit_Messages; + end Emit_Messages; + + -- Local variables + + Target : constant Entity_Id := Defining_Identifier (Decl); + Target_Typ : constant Node_Id := Etype (Target); + Expr : Node_Id; + + -- Start of processing for Check_Declaration_Legality + + begin + case N_Declaration'(Nkind (Decl)) is + when N_Full_Type_Declaration => + Check_Type_Legality (Target, Force, Legal); + + when N_Subtype_Declaration => + null; + + when N_Object_Declaration => + Expr := Expression (Decl); + + Check_Type_Legality (Target_Typ, Force, Legal); -- A declaration of a stand-alone object of an anonymous access -- type shall have an explicit initial value and shall occur @@ -1453,26 +1570,6 @@ package body Sem_SPARK is end if; end if; - if Present (Expr) then - Check_Assignment (Target => Target, - Expr => Expr); - end if; - - if Is_Deep (Target_Typ) then - declare - Tree : constant Perm_Tree_Access := - new Perm_Tree_Wrapper' - (Tree => - (Kind => Entire_Object, - Is_Node_Deep => True, - Explanation => Decl, - Permission => Read_Write, - Children_Permission => Read_Write)); - begin - Set (Current_Perm_Env, Target, Tree); - end; - end if; - when N_Iterator_Specification => null; @@ -1504,7 +1601,7 @@ package body Sem_SPARK is when N_Expression_Function => raise Program_Error; end case; - end Check_Declaration; + end Check_Declaration_Legality; ---------------------- -- Check_Expression -- @@ -2668,6 +2765,12 @@ package body Sem_SPARK is when N_Subprogram_Declaration => Check_Subprogram_Contract (N); + -- Attribute references in statement position are not supported in + -- SPARK and will be rejected by GNATprove. + + when N_Attribute_Reference => + null; + -- Ignored constructs for pointer checking when N_Abstract_Subprogram_Declaration @@ -3503,13 +3606,38 @@ package body Sem_SPARK is end case; end Check_Statement; - ---------------- - -- Check_Type -- - ---------------- + ------------------------- + -- Check_Type_Legality -- + ------------------------- + + procedure Check_Type_Legality + (Typ : Entity_Id; + Force : Boolean; + Legal : in out Boolean) + is + function Original_Emit_Messages return Boolean renames Emit_Messages; + + function Emit_Messages return Boolean; + -- Local wrapper around generic formal parameter Emit_Messages, to + -- check the value of parameter Force before calling the original + -- Emit_Messages, and setting Legal to False. + + ------------------- + -- Emit_Messages -- + ------------------- + + function Emit_Messages return Boolean is + begin + Legal := False; + return Force and then Original_Emit_Messages; + end Emit_Messages; + + -- Local variables - procedure Check_Type (Typ : Entity_Id) is Check_Typ : constant Entity_Id := Retysp (Typ); + -- Start of processing for Check_Type_Legality + begin case Type_Kind'(Ekind (Check_Typ)) is when Access_Kind => @@ -3519,7 +3647,7 @@ package body Sem_SPARK is => null; when E_Access_Subtype => - Check_Type (Base_Type (Check_Typ)); + Check_Type_Legality (Base_Type (Check_Typ), Force, Legal); when E_Access_Attribute_Type => if Emit_Messages then Error_Msg_N ("access attribute not allowed in SPARK", @@ -3546,7 +3674,7 @@ package body Sem_SPARK is when E_Array_Type | E_Array_Subtype => - Check_Type (Component_Type (Check_Typ)); + Check_Type_Legality (Component_Type (Check_Typ), Force, Legal); when Record_Kind => if Is_Deep (Check_Typ) @@ -3569,7 +3697,7 @@ package body Sem_SPARK is -- Ignore components which are not visible in SPARK if Component_Is_Visible_In_SPARK (Comp) then - Check_Type (Etype (Comp)); + Check_Type_Legality (Etype (Comp), Force, Legal); end if; Next_Component_Or_Discriminant (Comp); end loop; @@ -3595,7 +3723,7 @@ package body Sem_SPARK is => null; end case; - end Check_Type; + end Check_Type_Legality; -------------- -- Get_Expl -- @@ -4141,6 +4269,24 @@ package body Sem_SPARK is end case; end Is_Deep; + -------------- + -- Is_Legal -- + -------------- + + function Is_Legal (N : Node_Id) return Boolean is + Legal : Boolean := True; + + begin + case Nkind (N) is + when N_Declaration => + Check_Declaration_Legality (N, Force => False, Legal => Legal); + when others => + null; + end case; + + return Legal; + end Is_Legal; + ---------------------- -- Is_Local_Context -- ---------------------- diff --git a/gcc/ada/sem_spark.ads b/gcc/ada/sem_spark.ads index 195e833..7c16281 100644 --- a/gcc/ada/sem_spark.ads +++ b/gcc/ada/sem_spark.ads @@ -152,6 +152,12 @@ generic package Sem_SPARK is + function Is_Legal (N : Node_Id) return Boolean; + -- Test the legality of a node wrt ownership-checking rules. This does not + -- check rules related to the validity of permissions associated with paths + -- from objects, so that it can be called from GNATprove on code of library + -- units analyzed in SPARK_Mode Auto. + procedure Check_Safe_Pointers (N : Node_Id); -- The entry point of this package. It analyzes a node and reports errors -- when there are violations of ownership rules. -- cgit v1.1 From 4cac730ccc741a9bf780390c2703163edc6da470 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Wed, 14 Aug 2019 09:51:29 +0000 Subject: [Ada] Sem_Util: fix a bug in New_Copy_Tree No impact on GCC-based compilation. 2019-08-14 Javier Miranda gcc/ada/ * sem_util.adb (New_Copy_Tree.Copy_Node_With_Replacement): Update the Chars attribute of identifiers. From-SVN: r274455 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem_util.adb | 15 +++++++++++++++ 2 files changed, 20 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1d13947..c661a38 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-14 Javier Miranda + + * sem_util.adb (New_Copy_Tree.Copy_Node_With_Replacement): + Update the Chars attribute of identifiers. + 2019-08-14 Yannick Moy * sem_spark.adb, sem_spark.ads (Is_Legal): New function exposed diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index db9233a..10f8ffb 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -20427,6 +20427,21 @@ package body Sem_Util is Update_First_Real_Statement (Old_HSS => N, New_HSS => Result); + + -- Update the Chars attribute of identifiers + + elsif Nkind (N) = N_Identifier then + + -- The Entity field of identifiers that denote aspects is used + -- to store arbitrary expressions (and hence we must check that + -- they reference an actual entity before copying their Chars + -- value). + + if Present (Entity (Result)) + and then Nkind (Entity (Result)) in N_Entity + then + Set_Chars (Result, Chars (Entity (Result))); + end if; end if; end if; -- cgit v1.1 From 16b9e3c32d0c52334644021e5e0465b1c43d190e Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Wed, 14 Aug 2019 09:51:34 +0000 Subject: [Ada] Crash on quantified expression in disabled assertion The defining identifier of a quantified expression may be the freeze point of its type. If the quantified expression appears in an assertion that is disavbled, the freeze node for that type may appear in a tree that will be discarded when the enclosing pragma is elaborated. To ensure that the freeze node is reachable for subsquent uses we must generate its freeze node explicitly when the quantified expression is analyzed. 2019-08-14 Ed Schonberg gcc/ada/ * exp_ch4.adb (Expand_N_Quantified_Expression): Freeze explicitly the type of the loop parameter. gcc/testsuite/ * gnat.dg/assert2.adb, gnat.dg/assert2.ads: New testcase. From-SVN: r274456 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/exp_ch4.adb | 22 ++++++++++++++++++++++ 2 files changed, 27 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c661a38..99b551f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-14 Ed Schonberg + + * exp_ch4.adb (Expand_N_Quantified_Expression): Freeze + explicitly the type of the loop parameter. + 2019-08-14 Javier Miranda * sem_util.adb (New_Copy_Tree.Copy_Node_With_Replacement): diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 4404c5d..00f9aae 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -10337,8 +10337,30 @@ package body Exp_Ch4 is Flag : Entity_Id; Scheme : Node_Id; Stmts : List_Id; + Var : Entity_Id; begin + -- Ensure that the bound variable is properly frozen. We must do + -- this before expansion because the expression is about to be + -- converted into a loop, and resulting freeze nodes may end up + -- in the wrong place in the tree. + + if Present (Iter_Spec) then + Var := Defining_Identifier (Iter_Spec); + else + Var := Defining_Identifier (Loop_Spec); + end if; + + declare + P : Node_Id := Parent (N); + begin + while Nkind (P) in N_Subexpr loop + P := Parent (P); + end loop; + + Freeze_Before (P, Etype (Var)); + end; + -- Create the declaration of the flag which tracks the status of the -- quantified expression. Generate: -- cgit v1.1 From 2a127979d92caafe31a2c9be5d9f5bb70e1f4d98 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 14 Aug 2019 09:51:39 +0000 Subject: [Ada] Fix internal error on inlined subprogram instance This fixes a long-standing oddity in the procedure analyzing the instantiation of a generic subprogram, which would set the Is_Generic_Instance flag on the enclosing package generated for the instantiation but only to reset it a few lines below. Now this flag is relied upon by the machinery which computes the set of public entities to be exposed by a package. 2019-08-14 Eric Botcazou gcc/ada/ * sem_ch12.adb (Analyze_Instance_And_Renamings): Do not reset the Is_Generic_Instance flag previously set on the package generated for the instantiation of a generic subprogram. gcc/testsuite/ * gnat.dg/generic_inst11.adb, gnat.dg/generic_inst11_pkg.adb, gnat.dg/generic_inst11_pkg.ads: New testcase. From-SVN: r274457 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/sem_ch12.adb | 4 ---- 2 files changed, 6 insertions(+), 4 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 99b551f..a36a83a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-14 Eric Botcazou + + * sem_ch12.adb (Analyze_Instance_And_Renamings): Do not reset + the Is_Generic_Instance flag previously set on the package + generated for the instantiation of a generic subprogram. + 2019-08-14 Ed Schonberg * exp_ch4.adb (Expand_N_Quantified_Expression): Freeze diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index f98f2fa..5f290ac 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -5264,10 +5264,6 @@ package body Sem_Ch12 is Analyze (Pack_Decl); Check_Formal_Packages (Pack_Id); - Set_Is_Generic_Instance (Pack_Id, False); - - -- Why do we clear Is_Generic_Instance??? We set it 20 lines - -- above??? -- Body of the enclosing package is supplied when instantiating the -- subprogram body, after semantic analysis is completed. -- cgit v1.1 From f056076f5fe77fe8b13050eb3affc4c8ac700722 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Wed, 14 Aug 2019 09:51:43 +0000 Subject: [Ada] Spurious error in discriminated aggregate This patch fixes a bug in which a spurious error is given on an aggregate of a type derived from a subtype with a constrained discriminant. 2019-08-14 Bob Duff gcc/ada/ * exp_aggr.adb (Init_Hidden_Discriminants): Avoid processing the wrong discriminant, which could be of the wrong type. gcc/testsuite/ * gnat.dg/discr57.adb: New testcase. From-SVN: r274458 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/exp_aggr.adb | 4 +++- 2 files changed, 8 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a36a83a..785d9d8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-14 Bob Duff + + * exp_aggr.adb (Init_Hidden_Discriminants): Avoid processing the + wrong discriminant, which could be of the wrong type. + 2019-08-14 Eric Botcazou * sem_ch12.adb (Analyze_Instance_And_Renamings): Do not reset diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 174da6e..6a756fd 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -2689,8 +2689,10 @@ package body Exp_Aggr is Discr_Constr := First_Elmt (Stored_Constraint (Full_View (Base_Typ))); + -- Otherwise, no discriminant to process + else - Discr_Constr := First_Elmt (Stored_Constraint (Typ)); + Discr_Constr := No_Elmt; end if; while Present (Discr) and then Present (Discr_Constr) loop -- cgit v1.1 From 0984258e474b6f071a995579fe5896d13fe2d58a Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 14 Aug 2019 09:51:48 +0000 Subject: [Ada] Remove obsolete Pending_Descriptor table and related bits The table has been unused for a while. No functional changes. 2019-08-14 Eric Botcazou gcc/ada/ * inline.ads (Pending_Descriptor): Delete. * inline.adb (Initialize): Do not initialize it. * sem_ch12.adb (Delay_Descriptors): Delete. (Analyze_Package_Instantiation): Call Set_Delay_Subprogram_Descriptors instead of Delay_Descriptors throughout. From-SVN: r274459 --- gcc/ada/ChangeLog | 9 +++++++++ gcc/ada/inline.adb | 1 - gcc/ada/inline.ads | 14 -------------- gcc/ada/sem_ch12.adb | 23 ++++------------------- 4 files changed, 13 insertions(+), 34 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 785d9d8..8f981a8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2019-08-14 Eric Botcazou + + * inline.ads (Pending_Descriptor): Delete. + * inline.adb (Initialize): Do not initialize it. + * sem_ch12.adb (Delay_Descriptors): Delete. + (Analyze_Package_Instantiation): Call + Set_Delay_Subprogram_Descriptors instead of Delay_Descriptors + throughout. + 2019-08-14 Bob Duff * exp_aggr.adb (Init_Hidden_Discriminants): Avoid processing the diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index aa8f7dd..862f047 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -4209,7 +4209,6 @@ package body Inline is procedure Initialize is begin - Pending_Descriptor.Init; Pending_Instantiations.Init; Inlined_Bodies.Init; Successors.Init; diff --git a/gcc/ada/inline.ads b/gcc/ada/inline.ads index e822ddc..5af42f9 100644 --- a/gcc/ada/inline.ads +++ b/gcc/ada/inline.ads @@ -108,20 +108,6 @@ package Inline is Table_Increment => Alloc.Pending_Instantiations_Increment, Table_Name => "Pending_Instantiations"); - -- The following table records subprograms and packages for which - -- generation of subprogram descriptors must be delayed. - - package Pending_Descriptor is new Table.Table ( - Table_Component_Type => Entity_Id, - Table_Index_Type => Int, - Table_Low_Bound => 0, - Table_Initial => Alloc.Pending_Instantiations_Initial, - Table_Increment => Alloc.Pending_Instantiations_Increment, - Table_Name => "Pending_Descriptor"); - - -- The following should be initialized in an init call in Frontend, we - -- have thoughts of making the frontend reusable in future ??? - ----------------- -- Subprograms -- ----------------- diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 5f290ac..06afd2a 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3846,9 +3846,6 @@ package body Sem_Ch12 is procedure Analyze_Package_Instantiation (N : Node_Id) is Has_Inline_Always : Boolean := False; - procedure Delay_Descriptors (E : Entity_Id); - -- Delay generation of subprogram descriptors for given entity - function Might_Inline_Subp (Gen_Unit : Entity_Id) return Boolean; -- If inlining is active and the generic contains inlined subprograms, -- we instantiate the body. This may cause superfluous instantiations, @@ -3856,18 +3853,6 @@ package body Sem_Ch12 is -- of inlining, when the context of the instance is not available. ----------------------- - -- Delay_Descriptors -- - ----------------------- - - procedure Delay_Descriptors (E : Entity_Id) is - begin - if not Delay_Subprogram_Descriptors (E) then - Set_Delay_Subprogram_Descriptors (E); - Pending_Descriptor.Append (E); - end if; - end Delay_Descriptors; - - ----------------------- -- Might_Inline_Subp -- ----------------------- @@ -4468,10 +4453,10 @@ package body Sem_Ch12 is if Ekind (Enclosing_Master) = E_Package then if Is_Compilation_Unit (Enclosing_Master) then if In_Package_Body (Enclosing_Master) then - Delay_Descriptors + Set_Delay_Subprogram_Descriptors (Body_Entity (Enclosing_Master)); else - Delay_Descriptors + Set_Delay_Subprogram_Descriptors (Enclosing_Master); end if; @@ -4511,7 +4496,7 @@ package body Sem_Ch12 is end loop; if Is_Subprogram (Enclosing_Master) then - Delay_Descriptors (Enclosing_Master); + Set_Delay_Subprogram_Descriptors (Enclosing_Master); elsif Is_Task_Type (Enclosing_Master) then declare @@ -4520,7 +4505,7 @@ package body Sem_Ch12 is (Enclosing_Master); begin if Present (TBP) then - Delay_Descriptors (TBP); + Set_Delay_Subprogram_Descriptors (TBP); Set_Delay_Cleanups (TBP); end if; end; -- cgit v1.1 From 6d0ca6acd0616ddac74d23c0bec3791e6c721142 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Wed, 14 Aug 2019 09:51:52 +0000 Subject: [Ada] Minor: remove a ??? comment Minor: remove the ??? comment for the Inside_A_Generic flag. The current name is clear and concise, even though we are noun-ing the adjective "generic". 2019-08-14 Bob Duff gcc/ada/ * sem.ads (Inside_A_Generic): Remove the ??? comment. From-SVN: r274460 --- gcc/ada/ChangeLog | 4 ++++ gcc/ada/sem.ads | 1 - 2 files changed, 4 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8f981a8..42d342f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,7 @@ +2019-08-14 Bob Duff + + * sem.ads (Inside_A_Generic): Remove the ??? comment. + 2019-08-14 Eric Botcazou * inline.ads (Pending_Descriptor): Delete. diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads index 9fbe86a..0c3e6c2 100644 --- a/gcc/ada/sem.ads +++ b/gcc/ada/sem.ads @@ -275,7 +275,6 @@ package Sem is -- flag is False to disable any code expansion (see package Expander). Only -- the generic processing can modify the status of this flag, any other -- client should regard it as read-only. - -- Probably should be called Inside_A_Generic_Template ??? Inside_Freezing_Actions : Nat := 0; -- Flag indicating whether we are within a call to Expand_N_Freeze_Actions. -- cgit v1.1 From 3a02b4697e38e506c2856c104261cfe87550548a Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Wed, 14 Aug 2019 09:51:57 +0000 Subject: [Ada] Tweak the sloc of Compile_Time_Warning warnings 2019-08-14 Bob Duff gcc/ada/ * sem_prag.adb (Validate_Compile_Time_Warning_Error): Attach the warning to the Sloc of the first pragma argument, rather than to the pragma itself. This is to make pragmas processed after the back end use the same Sloc as pragmas processed earlier, in the front end. There's no reason for this discrepancy, and it hinders further work on this ticket. From-SVN: r274461 --- gcc/ada/ChangeLog | 9 +++++++++ gcc/ada/sem_prag.adb | 7 ++++--- 2 files changed, 13 insertions(+), 3 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 42d342f..773b705 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,14 @@ 2019-08-14 Bob Duff + * sem_prag.adb (Validate_Compile_Time_Warning_Error): Attach the + warning to the Sloc of the first pragma argument, rather than to + the pragma itself. This is to make pragmas processed after the + back end use the same Sloc as pragmas processed earlier, in the + front end. There's no reason for this discrepancy, and it + hinders further work on this ticket. + +2019-08-14 Bob Duff + * sem.ads (Inside_A_Generic): Remove the ??? comment. 2019-08-14 Eric Botcazou diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 0f822bf..1db39f4 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -336,8 +336,8 @@ package body Sem_Prag is -- and alignment values performed by the back end. -- Note: the reason we store a Source_Ptr value instead of a Node_Id is - -- that by the time Validate_Unchecked_Conversions is called, Sprint will - -- already have modified all Sloc values if the -gnatD option is set. + -- that by the time Validate_Compile_Time_Warning_Errors is called, Sprint + -- will already have modified all Sloc values if the -gnatD option is set. type CTWE_Entry is record Eloc : Source_Ptr; @@ -32147,9 +32147,10 @@ package body Sem_Prag is ----------------------------------------- procedure Validate_Compile_Time_Warning_Error (N : Node_Id) is + Arg1 : constant Node_Id := First (Pragma_Argument_Associations (N)); begin Compile_Time_Warnings_Errors.Append - (New_Val => CTWE_Entry'(Eloc => Sloc (N), + (New_Val => CTWE_Entry'(Eloc => Sloc (Arg1), Scope => Current_Scope, Prag => N)); end Validate_Compile_Time_Warning_Error; -- cgit v1.1 From 27af94e7b9a4702ea93348f917fd2ad82adb6853 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 14 Aug 2019 09:52:01 +0000 Subject: [Ada] Remove documentation of gnatelim 2019-08-14 Arnaud Charlet gcc/ada/ * doc/gnat_ugn/gnat_and_program_execution.rst: Remove documentation of gnatelim. From-SVN: r274462 --- gcc/ada/ChangeLog | 5 + .../doc/gnat_ugn/gnat_and_program_execution.rst | 269 +-------------------- 2 files changed, 7 insertions(+), 267 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 773b705..b7bacdc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-14 Arnaud Charlet + + * doc/gnat_ugn/gnat_and_program_execution.rst: Remove + documentation of gnatelim. + 2019-08-14 Bob Duff * sem_prag.adb (Validate_Compile_Time_Warning_Error): Attach the diff --git a/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst b/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst index de348e9..d2675c7 100644 --- a/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst +++ b/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst @@ -1406,18 +1406,8 @@ This section presents several topics related to program performance. It first describes some of the tradeoffs that need to be considered and some of the techniques for making your program run faster. -.. only:: PRO or GPL - - It then documents the unused subprogram/data elimination feature - and the ``gnatelim`` tool, - which can reduce the size of program executables. - - -.. only:: FSF - - It then documents the unused subprogram/data elimination feature, - which can reduce the size of program executables. - +It then documents the unused subprogram/data elimination feature, +which can reduce the size of program executables. .. _Performance_Considerations: @@ -2596,261 +2586,6 @@ It can be observed that the procedure ``Unused`` and the object ``Unused_Data`` are removed by the linker when using the appropriate options. -.. only:: PRO or GPL - - .. _Reducing_Size_of_Ada_Executables_with_gnatelim: - - Reducing Size of Ada Executables with ``gnatelim`` - -------------------------------------------------- - - .. index:: gnatelim - - This section describes ``gnatelim``, a tool which detects unused - subprograms and helps the compiler to create a smaller executable for your - program. - - ``gnatelim`` is a project-aware tool. - (See :ref:`Using_Project_Files_with_GNAT_Tools` for a description of - the project-related switches but note that ``gnatelim`` does not support - the :samp:`-U {main_unit}`, :samp:`--subdirs={dir}`, or - :samp:`--no_objects_dir` switches.) - The project file package that can specify - ``gnatelim`` switches is named ``Eliminate``. - - .. _About_gnatelim: - - About ``gnatelim`` - ^^^^^^^^^^^^^^^^^^ - - When a program shares a set of Ada - packages with other programs, it may happen that this program uses - only a fraction of the subprograms defined in these packages. The code - created for these unused subprograms increases the size of the executable. - - ``gnatelim`` tracks unused subprograms in an Ada program and - outputs a list of GNAT-specific pragmas ``Eliminate`` marking all the - subprograms that are declared but never called. By placing the list of - ``Eliminate`` pragmas in the GNAT configuration file :file:`gnat.adc` and - recompiling your program, you may decrease the size of its executable, - because the compiler will not generate the code for 'eliminated' subprograms. - See ``Pragma_Eliminate`` in the :title:`GNAT_Reference_Manual` for more - information about this pragma. - - ``gnatelim`` needs as its input data the name of the main subprogram. - - If a set of source files is specified as ``gnatelim`` arguments, it - treats these files as a complete set of sources making up a program to - analyse, and analyses only these sources. - - If ``gnatelim`` is called with a project file and :samp:`-U` option is - used, then in process all the files from the argument project but - not just the closure of the main subprogram. - - In all the other cases (that are typical cases of ``gnatelim`` usage, when - the only ``gnatelim`` parameter is the name of the source file containing - the main subprogram) gnatelim needs the full closure of the main subprogram. - When called with a project file, gnatelim computes this closure itself. - Otherwise it assumes that it can reuse the results of the previous - build of the main subprogram. - - If the set of sources to be processed by ``gnatelim`` contains sources with - preprocessing directives - then the needed options should be provided to run preprocessor as a part of - the ``gnatelim`` call, and the generated set of pragmas ``Eliminate`` - will correspond to preprocessed sources. - - - .. _Running_gnatelim: - - Running ``gnatelim`` - ^^^^^^^^^^^^^^^^^^^^ - - ``gnatelim`` has the following command-line interface: - - - :: - - $ gnatelim [switches] -main=`main_unit_name {filename} [-cargs gcc_switches] - - ``main_unit_name`` should be a name of a source file that contains the main - subprogram of a program (partition). - - Each ``filename`` is the name (including the extension) of a source - file to process. 'Wildcards' are allowed, and - the file name may contain path information. - - ``gcc_switches`` is a list of switches for - ``gcc``. They will be passed on to all compiler invocations made by - ``gnatelim`` to generate the ASIS trees. Here you can provide - :switch:`-I` switches to form the source search path, - use the :switch:`-gnatec` switch to set the configuration file, - use the :switch:`-gnat05` switch if sources should be compiled in - Ada 2005 mode etc. - - ``gnatelim`` has the following switches: - - - .. index:: --version (gnatelim) - - :samp:`--version` - Display Copyright and version, then exit disregarding all other options. - - - .. index:: --help (gnatelim) - - :samp:`--help` - Display usage, then exit disregarding all other options. - - - .. index:: -P (gnatelim) - - :samp:`-P {file}` - Indicates the name of the project file that describes the set of sources - to be processed. - - - .. index:: -X (gnatelim) - - :samp:`-X{name}={value}` - Indicates that external variable ``name`` in the argument project - has the value ``value``. Has no effect if no project is specified as - tool argument. - - - .. index:: --RTS (gnatelim) - - :samp:`--RTS={rts-path}` - Specifies the default location of the runtime library. Same meaning as the - equivalent ``gnatmake`` flag (:ref:`Switches_for_gnatmake`). - - - .. index:: -U (gnatelim) - - :samp:`-U` - Process all the sources from the argument project. If no project file - is specified, this option has no effect. If this option is used with the - project file, ``gnatelim`` does not require the preliminary build of the - argument main subprogram. - - - .. index:: -files (gnatelim) - - :samp:`-files={filename}` - Take the argument source files from the specified file. This file should be an - ordinary text file containing file names separated by spaces or - line breaks. You can use this switch more than once in the same call to - ``gnatelim``. You also can combine this switch with - an explicit list of files. - - - .. index:: -log (gnatelim) - - :samp:`-log` - Duplicate all the output sent to :file:`stderr` into a log file. The log file - is named :file:`gnatelim.log` and is located in the current directory. - - .. index:: --no-elim-dispatch (gnatelim) - - :samp:`--no-elim-dispatch` - Do not generate pragmas for dispatching operations. - - - .. index:: --ignore (gnatelim) - - :samp:`--ignore={filename}` - Do not generate pragmas for subprograms declared in the sources - listed in a specified file - - .. index:: -o (gnatelim) - - - :samp:`-o={report_file}` - Put ``gnatelim`` output into a specified file. If this file already exists, - it is overridden. If this switch is not used, ``gnatelim`` outputs its results - into :file:`stderr` - - - .. index:: -j (gnatelim) - - :samp:`-j{n}` - Use ``n`` processes to carry out the tree creations (internal representations - of the argument sources). On a multiprocessor machine this speeds up processing - of big sets of argument sources. If ``n`` is 0, then the maximum number of - parallel tree creations is the number of core processors on the platform. - This possibility is disabled if ``gnatelim`` has to compute the closure - of the main unit. - - - .. index:: -q (gnatelim) - - :samp:`-q` - Quiet mode: by default ``gnatelim`` outputs to the standard error - stream the number of program units left to be processed. This option turns - this trace off. - - .. index:: -t (gnatelim) - - - :samp:`-t` - Print out execution time. - - - .. index:: -v (gnatelim) - - :samp:`-v` - Verbose mode: ``gnatelim`` version information is printed as Ada - comments to the standard output stream. Also, in addition to the number of - program units left ``gnatelim`` will output the name of the current unit - being processed. - - - .. index:: -wq (gnatelim) - - :samp:`-wq` - Quiet warning mode - some warnings are suppressed. In particular warnings that - indicate that the analysed set of sources is incomplete to make up a - partition and that some subprogram bodies are missing are not generated. - - - - .. _Processing_Precompiled_Libraries: - - Processing Precompiled Libraries - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - - If some program uses a precompiled Ada library, it can be processed by - ``gnatelim`` in a usual way. ``gnatelim`` will newer generate an - Eliminate pragma for a subprogram if the body of this subprogram has not - been analysed, this is a typical case for subprograms from precompiled - libraries. Switch :switch:`-wq` may be used to suppress - warnings about missing source files and non-analyzed subprogram bodies - that can be generated when processing precompiled Ada libraries. - - - .. _Correcting_the_List_of_Eliminate_Pragmas: - - Correcting the List of Eliminate Pragmas - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - - In some rare cases ``gnatelim`` may try to eliminate - subprograms that are actually called in the program. In this case, the - compiler will generate an error message of the form: - - :: - - main.adb:4:08: cannot reference subprogram "P" eliminated at elim.out:5 - - You will need to manually remove the wrong ``Eliminate`` pragmas from - the configuration file indicated in the error message. You should recompile - your program from scratch after that, because you need a consistent - configuration file(s) during the entire compilation. - - If ``gnatelim`` is called with a project file and with ``-U`` option - the generated set of pragmas may contain pragmas for subprograms that - does not belong to the closure of the argument main subprogram. These - pragmas has no effect when the set of pragmas is used to reduce the size - of executable. - .. index:: Overflow checks .. index:: Checks (overflow) -- cgit v1.1 From ae3a2b54d1a19f9ca4941645f71dddf675fbd19c Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Wed, 14 Aug 2019 09:52:06 +0000 Subject: [Ada] Strengthen Locked flag This patch strengthens the Locked flag, by Asserting that it is False on operations that might cause reallocation. No change in behavior (except in the presence of compiler bugs), so no test. 2019-08-14 Bob Duff gcc/ada/ * table.adb: Assert that the table is not locked when increasing Last, even if it doesn't cause reallocation. In other words, assert that on operations that MIGHT cause reallocation. * table.ads: Fix comment accordingly. From-SVN: r274463 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/table.adb | 4 ++++ gcc/ada/table.ads | 17 +++++++++-------- 3 files changed, 20 insertions(+), 8 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b7bacdc..7c09cc0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-08-14 Bob Duff + + * table.adb: Assert that the table is not locked when increasing + Last, even if it doesn't cause reallocation. In other words, + assert that on operations that MIGHT cause reallocation. + * table.ads: Fix comment accordingly. + 2019-08-14 Arnaud Charlet * doc/gnat_ugn/gnat_and_program_execution.rst: Remove diff --git a/gcc/ada/table.adb b/gcc/ada/table.adb index ebbb857..9794047 100644 --- a/gcc/ada/table.adb +++ b/gcc/ada/table.adb @@ -80,6 +80,7 @@ package body Table is procedure Append (New_Val : Table_Component_Type) is begin + pragma Assert (not Locked); Set_Item (Table_Index_Type (Last_Val + 1), New_Val); end Append; @@ -120,6 +121,7 @@ package body Table is procedure Increment_Last is begin + pragma Assert (not Locked); Last_Val := Last_Val + 1; if Last_Val > Max then @@ -384,6 +386,8 @@ package body Table is procedure Set_Last (New_Val : Table_Index_Type) is begin + pragma Assert (Int (New_Val) <= Last_Val or else not Locked); + if Int (New_Val) < Last_Val then Last_Val := Int (New_Val); diff --git a/gcc/ada/table.ads b/gcc/ada/table.ads index a816c73..5f03cf3 100644 --- a/gcc/ada/table.ads +++ b/gcc/ada/table.ads @@ -130,14 +130,15 @@ package Table is -- First .. Last. Locked : Boolean := False; - -- Table expansion is permitted only if this switch is set to False. A - -- client may set Locked to True, in which case any attempt to expand - -- the table will cause an assertion failure. Note that while a table - -- is locked, its address in memory remains fixed and unchanging. This - -- feature is used to control table expansion during Gigi processing. - -- Gigi assumes that tables other than the Uint and Ureal tables do - -- not move during processing, which means that they cannot be expanded. - -- The Locked flag is used to enforce this restriction. + -- Increasing the value of Last is permitted only if this switch is set + -- to False. A client may set Locked to True, in which case any attempt + -- to increase the value of Last (which might expand the table) will + -- cause an assertion failure. Note that while a table is locked, its + -- address in memory remains fixed and unchanging. This feature is used + -- to control table expansion during Gigi processing. Gigi assumes that + -- tables other than the Uint and Ureal tables do not move during + -- processing, which means that they cannot be expanded. The Locked + -- flag is used to enforce this restriction. procedure Init; -- This procedure allocates a new table of size Initial (freeing any -- cgit v1.1 From 72e324b6d8cb43b07eb3927f7d150b93105d1add Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Wed, 14 Aug 2019 09:52:10 +0000 Subject: [Ada] Equality for nonabstract type derived from interface treated as abstract The compiler was creating an abstract function for the equality operation of a (nonlimited) interface type, and that could result in errors on generic instantiations that are passed nonabstract types derived from the interface type along with the derived type's inherited equality operation (complaining about an abstract subprogram being passed to a nonabstract formal). The "=" operation of an interface is supposed to be nonabstract (a direct consequence of the rule in RM 4.5.2(6-7)), so we now create an expression function rather than an abstract function. The function returns False, but the result is unimportant since a function of an abstract type can never actually be invoked (its arguments must generally be class-wide, since there can be no objects of the type, and calling it will dispatch). 2019-08-14 Gary Dismukes gcc/ada/ * exp_ch3.adb (Predef_Spec_Or_Body): For an equality operation of an interface type, create an expression function (that returns False) rather than declaring an abstract function. * freeze.adb (Check_Inherited_Conditions): Set Needs_Wrapper to False unconditionally at the start of the loop creating wrappers for inherited operations. gcc/testsuite/ * gnat.dg/equal11.adb, gnat.dg/equal11_interface.ads, gnat.dg/equal11_record.adb, gnat.dg/equal11_record.ads: New testcase. From-SVN: r274464 --- gcc/ada/ChangeLog | 9 +++++++++ gcc/ada/exp_ch3.adb | 18 +++++++++++++++++- gcc/ada/freeze.adb | 8 +++----- 3 files changed, 29 insertions(+), 6 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7c09cc0..1b9e285 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2019-08-14 Gary Dismukes + + * exp_ch3.adb (Predef_Spec_Or_Body): For an equality operation + of an interface type, create an expression function (that + returns False) rather than declaring an abstract function. + * freeze.adb (Check_Inherited_Conditions): Set Needs_Wrapper to + False unconditionally at the start of the loop creating wrappers + for inherited operations. + 2019-08-14 Bob Duff * table.adb: Assert that the table is not locked when increasing diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 834aaa3..1901ea5 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -10313,8 +10313,24 @@ package body Exp_Ch3 is Result_Definition => New_Occurrence_Of (Ret_Type, Loc)); end if; + -- Declare an abstract subprogram for primitive subprograms of an + -- interface type (except for "="). + if Is_Interface (Tag_Typ) then - return Make_Abstract_Subprogram_Declaration (Loc, Spec); + if Name /= Name_Op_Eq then + return Make_Abstract_Subprogram_Declaration (Loc, Spec); + + -- The equality function (if any) for an interface type is defined + -- to be nonabstract, so we create an expression function for it that + -- always returns False. Note that the function can never actually be + -- invoked because interface types are abstract, so there aren't any + -- objects of such types (and their equality operation will always + -- dispatch). + + else + return Make_Expression_Function + (Loc, Spec, New_Occurrence_Of (Standard_False, Loc)); + end if; -- If body case, return empty subprogram body. Note that this is ill- -- formed, because there is not even a null statement, and certainly not diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index e4d52f6..78d1ed4 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1526,11 +1526,11 @@ package body Freeze is -- so that LSP can be verified/enforced. Op_Node := First_Elmt (Prim_Ops); - Needs_Wrapper := False; while Present (Op_Node) loop - Decls := Empty_List; - Prim := Node (Op_Node); + Decls := Empty_List; + Prim := Node (Op_Node); + Needs_Wrapper := False; if not Comes_From_Source (Prim) and then Present (Alias (Prim)) then Par_Prim := Alias (Prim); @@ -1601,8 +1601,6 @@ package body Freeze is (Par_R, New_List (New_Decl, New_Body)); end if; end; - - Needs_Wrapper := False; end if; Next_Elmt (Op_Node); -- cgit v1.1 From 4b96d3861e74b8df1032f4317230408248e4bf09 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 14 Aug 2019 09:52:15 +0000 Subject: [Ada] Compiler speedup with inlining across units This change is aimed at speeding up the inlining across units done by the Ada compiler when -gnatn is specified and in the presence of units instantiating a lot of generic packages. The current implementation is as follows: when a generic package is being instantiated, the compiler scans its spec for the presence of subprograms with an aspect/pragma Inline and, upon finding one, schedules the instantiation of its body. That's not very efficient because the compiler doesn't know yet if one of those inlined subprograms will eventually be called from the main unit. The new implementation arranges for the compiler to instantiate the body on demand, i.e. when it encounters a call to one of the inlined subprograms. That's still not optimal because, at this point, the compiler has not yet computed whether the call itself is reachable from the main unit (it will do this computation at the very end of the processing, just before sending the inlined units to the code generator) but that's nevertheless a net progress. The patch also enhances the -gnatd.j option to make it output the list of instances "inlined" this way. The following package is a simple example: with Q; procedure P is begin Q.Proc; end; package Q is procedure Proc; pragma Inline (Proc); end Q; with G; package body Q is package My_G is new G (1); procedure Proc is Val : constant Integer := My_G.Func; begin if Val /= 1 then raise Program_Error; end if; end; end Q; generic Value : Integer; package G is function Func return Integer; pragma Inline (Func); end G; package body G is function Func return Integer is begin return Value; end; end G; 2019-08-14 Eric Botcazou gcc/ada/ * einfo.ads (Is_Called): Document new usage on E_Package entities. * einfo.adb (Is_Called): Accept E_Package entities. (Set_Is_Called): Likewise. * exp_ch6.adb (Expand_Call_Helper): Move code dealing with instances for back-end inlining to Add_Inlined_Body. * inline.ads: Remove with clauses for Alloc and Table. (Pending_Instantiations): Move to... * inline.adb: Add with clauses for Alloc, Uintp, Table and GNAT.HTable. (Backend_Instances): New variable. (Pending_Instantiations): ...here. (Called_Pending_Instantiations): New table. (Node_Table_Size): New constant. (Node_Header_Num): New subtype. (Node_Hash): New function. (To_Pending_Instantiations): New hash table. (Add_Inlined_Body): Bail out early for subprograms in the main unit or subunit. Likewise if the Is_Called flag is set. If the subprogram is an instance, invoke Add_Inlined_Instance. Call Set_Is_Called earlier. If the subrogram is within an instance, invoke Add_Inlined_Instance. Also deal with the case where the call itself is within an instance. (Add_Inlined_Instance): New procedure. (Add_Inlined_Subprogram): Remove conditions always fulfilled. (Add_Pending_Instantiation): Move the defence against ludicruous number of instantiations to here. When back-end inlining is enabled, associate an instantiation with its index in table and mark a few selected kinds of instantiations as always needed. (Initialize): Set Backend_Instances to No_Elist. (Instantiate_Body): New procedure doing the work extracted from... (Instantiate_Bodies): ...here. When back-end inlining is enabled, loop over Called_Pending_Instantiations instead of Pending_Instantiations. (Is_Nested): Minor tweak. (List_Inlining_Info): Also list the contents of Backend_Instances. * sem_ch12.adb (Might_Inline_Subp): Return early if Is_Inlined is set and otherwise set it before returning true. (Analyze_Package_Instantiation): Remove the defence against ludicruous number of instantiations. Invoke Remove_Dead_Instance instead of doing the removal manually if there is a guaranteed ABE. From-SVN: r274465 --- gcc/ada/ChangeLog | 47 +++++++ gcc/ada/einfo.adb | 4 +- gcc/ada/einfo.ads | 11 +- gcc/ada/exp_ch6.adb | 56 -------- gcc/ada/inline.adb | 366 ++++++++++++++++++++++++++++++++++++++++++++------- gcc/ada/inline.ads | 10 -- gcc/ada/sem_ch12.adb | 21 ++- 7 files changed, 385 insertions(+), 130 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1b9e285..6cabf26 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,50 @@ +2019-08-14 Eric Botcazou + + * einfo.ads (Is_Called): Document new usage on E_Package + entities. + * einfo.adb (Is_Called): Accept E_Package entities. + (Set_Is_Called): Likewise. + * exp_ch6.adb (Expand_Call_Helper): Move code dealing with + instances for back-end inlining to Add_Inlined_Body. + * inline.ads: Remove with clauses for Alloc and Table. + (Pending_Instantiations): Move to... + * inline.adb: Add with clauses for Alloc, Uintp, Table and + GNAT.HTable. + (Backend_Instances): New variable. + (Pending_Instantiations): ...here. + (Called_Pending_Instantiations): New table. + (Node_Table_Size): New constant. + (Node_Header_Num): New subtype. + (Node_Hash): New function. + (To_Pending_Instantiations): New hash table. + (Add_Inlined_Body): Bail out early for subprograms in the main + unit or subunit. Likewise if the Is_Called flag is set. If the + subprogram is an instance, invoke Add_Inlined_Instance. Call + Set_Is_Called earlier. If the subrogram is within an instance, + invoke Add_Inlined_Instance. Also deal with the case where the + call itself is within an instance. + (Add_Inlined_Instance): New procedure. + (Add_Inlined_Subprogram): Remove conditions always fulfilled. + (Add_Pending_Instantiation): Move the defence against ludicruous + number of instantiations to here. When back-end inlining is + enabled, associate an instantiation with its index in table and + mark a few selected kinds of instantiations as always needed. + (Initialize): Set Backend_Instances to No_Elist. + (Instantiate_Body): New procedure doing the work extracted + from... + (Instantiate_Bodies): ...here. When back-end inlining is + enabled, loop over Called_Pending_Instantiations instead of + Pending_Instantiations. + (Is_Nested): Minor tweak. + (List_Inlining_Info): Also list the contents of + Backend_Instances. + * sem_ch12.adb (Might_Inline_Subp): Return early if Is_Inlined + is set and otherwise set it before returning true. + (Analyze_Package_Instantiation): Remove the defence against + ludicruous number of instantiations. Invoke + Remove_Dead_Instance instead of doing the removal manually if + there is a guaranteed ABE. + 2019-08-14 Gary Dismukes * exp_ch3.adb (Predef_Spec_Or_Body): For an equality operation diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 0438c8e..957bfe6 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -2140,7 +2140,7 @@ package body Einfo is function Is_Called (Id : E) return B is begin - pragma Assert (Ekind_In (Id, E_Procedure, E_Function)); + pragma Assert (Ekind_In (Id, E_Procedure, E_Function, E_Package)); return Flag102 (Id); end Is_Called; @@ -5344,7 +5344,7 @@ package body Einfo is procedure Set_Is_Called (Id : E; V : B := True) is begin - pragma Assert (Ekind_In (Id, E_Procedure, E_Function)); + pragma Assert (Ekind_In (Id, E_Procedure, E_Function, E_Package)); Set_Flag102 (Id, V); end Set_Is_Called; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 007b7d2..b879753 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2366,9 +2366,9 @@ package Einfo is -- i.e. Standard.Boolean and all types ultimately derived from it. -- Is_Called (Flag102) --- Defined in subprograms. Returns true if the subprogram is called --- in the unit being compiled or in a unit in the context. Used for --- inlining. +-- Defined in subprograms and packages. Set if a subprogram is called +-- from the unit being compiled or a unit in the closure. Also set for +-- a package that contains called subprograms. Used only for inlining. -- Is_Character_Type (Flag63) -- Defined in all entities. Set for character types and subtypes, @@ -6406,12 +6406,13 @@ package Einfo is -- Has_Master_Entity (Flag21) -- Has_RACW (Flag214) (non-generic case only) -- Ignore_SPARK_Mode_Pragmas (Flag301) - -- In_Package_Body (Flag48) - -- In_Use (Flag8) + -- Is_Called (Flag102) (non-generic case only) -- Is_Elaboration_Checks_OK_Id (Flag148) -- Is_Elaboration_Warnings_OK_Id (Flag304) -- Is_Instantiated (Flag126) + -- In_Package_Body (Flag48) -- Is_Private_Descendant (Flag53) + -- In_Use (Flag8) -- Is_Visible_Lib_Unit (Flag116) -- Renamed_In_Spec (Flag231) (non-generic case only) -- SPARK_Aux_Pragma_Inherited (Flag266) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 128fb90..c182072 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -4443,62 +4443,6 @@ package body Exp_Ch6 is or else Has_Pragma_Inline_Always (Subp) then Add_Inlined_Body (Subp, Call_Node); - - -- If the inlined call appears within an instance, then ensure - -- that the enclosing instance body is available so the back end - -- can actually perform the inlining. - - if In_Instance and then Comes_From_Source (Subp) then - declare - Decl : Node_Id; - Inst : Entity_Id; - Inst_Node : Node_Id; - - begin - Inst := Scope (Subp); - - -- Find enclosing instance - - while Present (Inst) and then Inst /= Standard_Standard loop - exit when Is_Generic_Instance (Inst); - Inst := Scope (Inst); - end loop; - - if Present (Inst) - and then Is_Generic_Instance (Inst) - and then not Is_Inlined (Inst) - then - Set_Is_Inlined (Inst); - Decl := Unit_Declaration_Node (Inst); - - -- Do not add a pending instantiation if the body exits - -- already, or if the instance is a compilation unit, or - -- the instance node is missing. - - if Present (Corresponding_Body (Decl)) - or else Nkind (Parent (Decl)) = N_Compilation_Unit - or else No (Next (Decl)) - then - null; - - else - -- The instantiation node usually follows the package - -- declaration for the instance. If the generic unit - -- has aspect specifications, they are transformed - -- into pragmas in the instance, and the instance node - -- appears after them. - - Inst_Node := Next (Decl); - - while Nkind (Inst_Node) /= N_Package_Instantiation loop - Inst_Node := Next (Inst_Node); - end loop; - - Add_Pending_Instantiation (Inst_Node, Decl); - end if; - end if; - end; - end if; end if; end if; diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 862f047..05830e1 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -23,6 +23,7 @@ -- -- ------------------------------------------------------------------------------ +with Alloc; with Aspects; use Aspects; with Atree; use Atree; with Debug; use Debug; @@ -51,8 +52,12 @@ with Sinfo; use Sinfo; with Sinput; use Sinput; with Snames; use Snames; with Stand; use Stand; -with Uname; use Uname; +with Table; with Tbuild; use Tbuild; +with Uintp; use Uintp; +with Uname; use Uname; + +with GNAT.HTable; package body Inline is @@ -82,12 +87,83 @@ package body Inline is Backend_Calls : Elist_Id; -- List of inline calls passed to the backend + Backend_Instances : Elist_Id; + -- List of instances inlined for the backend + Backend_Inlined_Subps : Elist_Id; -- List of subprograms inlined by the backend Backend_Not_Inlined_Subps : Elist_Id; -- List of subprograms that cannot be inlined by the backend + ----------------------------- + -- Pending_Instantiations -- + ----------------------------- + + -- We make entries in this table for the pending instantiations of generic + -- bodies that are created during semantic analysis. After the analysis is + -- complete, calling Instantiate_Bodies performs the actual instantiations. + + package Pending_Instantiations is new Table.Table ( + Table_Component_Type => Pending_Body_Info, + Table_Index_Type => Int, + Table_Low_Bound => 0, + Table_Initial => Alloc.Pending_Instantiations_Initial, + Table_Increment => Alloc.Pending_Instantiations_Increment, + Table_Name => "Pending_Instantiations"); + + ------------------------------------- + -- Called_Pending_Instantiations -- + ------------------------------------- + + -- With back-end inlining, the pending instantiations that are not in the + -- main unit or subunit are performed only after a call to the subprogram + -- instance, or to a subprogram within the package instance, is inlined. + -- Since such a call can be within a subsequent pending instantiation, + -- we make entries in this table that stores the index of these "called" + -- pending instantiations and perform them when the table is populated. + + package Called_Pending_Instantiations is new Table.Table ( + Table_Component_Type => Int, + Table_Index_Type => Int, + Table_Low_Bound => 0, + Table_Initial => Alloc.Pending_Instantiations_Initial, + Table_Increment => Alloc.Pending_Instantiations_Increment, + Table_Name => "Called_Pending_Instantiations"); + + --------------------------------- + -- To_Pending_Instantiations -- + --------------------------------- + + -- With back-end inlining, we also need to have a map from the pending + -- instantiations to their index in the Pending_Instantiations table. + + Node_Table_Size : constant := 257; + -- Number of headers in hash table + + subtype Node_Header_Num is Integer range 0 .. Node_Table_Size - 1; + -- Range of headers in hash table + + function Node_Hash (Id : Node_Id) return Node_Header_Num; + -- Simple hash function for Node_Ids + + package To_Pending_Instantiations is new GNAT.Htable.Simple_HTable + (Header_Num => Node_Header_Num, + Element => Int, + No_Element => -1, + Key => Node_Id, + Hash => Node_Hash, + Equal => "="); + + ----------------- + -- Node_Hash -- + ----------------- + + function Node_Hash (Id : Node_Id) return Node_Header_Num is + begin + return Node_Header_Num (Id mod Node_Table_Size); + end Node_Hash; + -------------------- -- Inlined Bodies -- -------------------- @@ -179,8 +255,11 @@ package body Inline is -- called, and for the inlined subprogram that contains the call. If -- the call is in the main compilation unit, Caller is Empty. + procedure Add_Inlined_Instance (E : Entity_Id); + -- Add instance E to the list of of inlined instances for the unit + procedure Add_Inlined_Subprogram (E : Entity_Id); - -- Add subprogram E to the list of inlined subprogram for the unit + -- Add subprogram E to the list of inlined subprograms for the unit function Add_Subp (E : Entity_Id) return Subp_Index; -- Make entry in Inlined table for subprogram E, or return table index @@ -429,17 +508,22 @@ package body Inline is return Dont_Inline; end Must_Inline; - Level : Inline_Level_Type; + Inst : Entity_Id; + Inst_Decl : Node_Id; + Inst_Node : Node_Id; + Level : Inline_Level_Type; -- Start of processing for Add_Inlined_Body begin Append_New_Elmt (N, To => Backend_Calls); - -- Skip subprograms that cannot be inlined outside their unit + -- Skip subprograms that cannot or need not be inlined outside their + -- unit or parent subprogram. if Is_Abstract_Subprogram (E) or else Convention (E) = Convention_Protected + or else In_Main_Unit_Or_Subunit (E) or else Is_Nested (E) then return; @@ -456,6 +540,22 @@ package body Inline is return; end if; + -- If a previous call to the subprogram has been inlined, nothing to do + + if Is_Called (E) then + return; + end if; + + -- If the subprogram is an instance, then inline the instance + + if Is_Generic_Instance (E) then + Add_Inlined_Instance (E); + end if; + + -- Mark the subprogram as called + + Set_Is_Called (E); + -- If the call was generated by the compiler and is to a subprogram in -- a run-time unit, we need to suppress debugging information for it, -- so that the code that is eventually inlined will not affect the @@ -476,7 +576,6 @@ package body Inline is -- in the spec. if Is_Non_Loading_Expression_Function (E) then - Set_Is_Called (E); return; end if; @@ -489,8 +588,6 @@ package body Inline is Pack : constant Entity_Id := Get_Code_Unit_Entity (E); begin - Set_Is_Called (E); - if Pack = E then Inlined_Bodies.Increment_Last; Inlined_Bodies.Table (Inlined_Bodies.Last) := E; @@ -498,6 +595,60 @@ package body Inline is else pragma Assert (Ekind (Pack) = E_Package); + -- If the subprogram is within an instance, inline the instance + + if Comes_From_Source (E) then + Inst := Scope (E); + + while Present (Inst) and then Inst /= Standard_Standard loop + exit when Is_Generic_Instance (Inst); + Inst := Scope (Inst); + end loop; + + if Present (Inst) + and then Is_Generic_Instance (Inst) + and then not Is_Called (Inst) + then + -- Do not add a pending instantiation if the body exits + -- already, or if the instance is a compilation unit, or + -- the instance node is missing. + + Inst_Decl := Unit_Declaration_Node (Inst); + if Present (Corresponding_Body (Inst_Decl)) + or else Nkind (Parent (Inst_Decl)) = N_Compilation_Unit + or else No (Next (Inst_Decl)) + then + Set_Is_Called (Inst); + + else + -- If the inlined call itself appears within an instance, + -- ensure that the enclosing instance body is available. + -- This is necessary because Sem_Ch12.Might_Inline_Subp + -- does not recurse into nested instantiations. + + if not Is_Inlined (Inst) and then In_Instance then + Set_Is_Inlined (Inst); + + -- The instantiation node usually follows the package + -- declaration for the instance. If the generic unit + -- has aspect specifications, they are transformed + -- into pragmas in the instance, and the instance node + -- appears after them. + + Inst_Node := Next (Inst_Decl); + + while Nkind (Inst_Node) /= N_Package_Instantiation loop + Inst_Node := Next (Inst_Node); + end loop; + + Add_Pending_Instantiation (Inst_Node, Inst_Decl); + end if; + + Add_Inlined_Instance (Inst); + end if; + end if; + end if; + -- If the unit containing E is an instance, then the instance body -- will be analyzed in any case, see Sem_Ch12.Might_Inline_Subp. @@ -534,6 +685,39 @@ package body Inline is end; end Add_Inlined_Body; + -------------------------- + -- Add_Inlined_Instance -- + -------------------------- + + procedure Add_Inlined_Instance (E : Entity_Id) is + Decl_Node : constant Node_Id := Unit_Declaration_Node (E); + Index : Int; + + begin + -- This machinery is only used with back-end inlining + + if not Back_End_Inlining then + return; + end if; + + -- Register the instance in the list + + Append_New_Elmt (Decl_Node, To => Backend_Instances); + + -- Retrieve the index of its corresponding pending instantiation + -- and mark this corresponding pending instantiation as needed. + + Index := To_Pending_Instantiations.Get (Decl_Node); + if Index >= 0 then + Called_Pending_Instantiations.Append (Index); + else + pragma Assert (False); + null; + end if; + + Set_Is_Called (E); + end Add_Inlined_Instance; + ---------------------------- -- Add_Inlined_Subprogram -- ---------------------------- @@ -570,21 +754,17 @@ package body Inline is -- Start of processing for Add_Inlined_Subprogram begin - -- If the subprogram is to be inlined, and if its unit is known to be - -- inlined or is an instance whose body will be analyzed anyway or the - -- subprogram was generated as a body by the compiler (for example an - -- initialization procedure) or its declaration was provided along with - -- the body (for example an expression function), and if it is declared - -- at the library level not in the main unit, and if it can be inlined - -- by the back-end, then insert it in the list of inlined subprograms. - - if Is_Inlined (E) - and then (Is_Inlined (Pack) - or else Is_Generic_Instance (Pack) - or else Nkind (Decl) = N_Subprogram_Body - or else Present (Corresponding_Body (Decl))) - and then not In_Main_Unit_Or_Subunit (E) - and then not Is_Nested (E) + -- We can inline the subprogram if its unit is known to be inlined or is + -- an instance whose body will be analyzed anyway or the subprogram was + -- generated as a body by the compiler (for example an initialization + -- procedure) or its declaration was provided along with the body (for + -- example an expression function) and it does not declare types with + -- nontrivial initialization procedures. + + if (Is_Inlined (Pack) + or else Is_Generic_Instance (Pack) + or else Nkind (Decl) = N_Subprogram_Body + or else Present (Corresponding_Body (Decl))) and then not Has_Initialized_Type (E) then Register_Backend_Inlined_Subprogram (E); @@ -607,7 +787,20 @@ package body Inline is -------------------------------- procedure Add_Pending_Instantiation (Inst : Node_Id; Act_Decl : Node_Id) is + Act_Decl_Id : Entity_Id; + Index : Int; + begin + -- Here is a defense against a ludicrous number of instantiations + -- caused by a circular set of instantiation attempts. + + if Pending_Instantiations.Last > Maximum_Instantiations then + Error_Msg_Uint_1 := UI_From_Int (Maximum_Instantiations); + Error_Msg_N ("too many instantiations, exceeds max of^", Inst); + Error_Msg_N ("\limit can be changed using -gnateinn switch", Inst); + raise Unrecoverable_Error; + end if; + -- Capture the body of the generic instantiation along with its context -- for later processing by Instantiate_Bodies. @@ -620,6 +813,30 @@ package body Inline is Local_Suppress_Stack_Top => Local_Suppress_Stack_Top, Scope_Suppress => Scope_Suppress, Warnings => Save_Warnings)); + + -- With back-end inlining, also associate the index to the instantiation + + if Back_End_Inlining then + Act_Decl_Id := Defining_Entity (Act_Decl); + Index := Pending_Instantiations.Last; + + To_Pending_Instantiations.Set (Act_Decl, Index); + + -- If an instantiation is either a compilation unit or is in the main + -- unit or subunit or is a nested subprogram, then its body is needed + -- as per the analysis already done in Analyze_Package_Instantiation + -- and Analyze_Subprogram_Instantiation. + + if Nkind (Parent (Inst)) = N_Compilation_Unit + or else In_Main_Unit_Or_Subunit (Act_Decl_Id) + or else (Is_Subprogram (Act_Decl_Id) + and then Is_Nested (Act_Decl_Id)) + then + Called_Pending_Instantiations.Append (Index); + + Set_Is_Called (Act_Decl_Id); + end if; + end if; end Add_Pending_Instantiation; ------------------------ @@ -4220,6 +4437,7 @@ package body Inline is Inlined_Calls := No_Elist; Backend_Calls := No_Elist; + Backend_Instances := No_Elist; Backend_Inlined_Subps := No_Elist; Backend_Not_Inlined_Subps := No_Elist; end Initialize; @@ -4236,9 +4454,36 @@ package body Inline is -- the body is an internal error. procedure Instantiate_Bodies is - J : Nat; + + procedure Instantiate_Body (Info : Pending_Body_Info); + -- Instantiate a pending body + + ------------------------ + -- Instantiate_Body -- + ------------------------ + + procedure Instantiate_Body (Info : Pending_Body_Info) is + begin + -- If the instantiation node is absent, it has been removed as part + -- of unreachable code. + + if No (Info.Inst_Node) then + null; + + elsif Nkind (Info.Act_Decl) = N_Package_Declaration then + Instantiate_Package_Body (Info); + Add_Scope_To_Clean (Defining_Entity (Info.Act_Decl)); + + else + Instantiate_Subprogram_Body (Info); + end if; + end Instantiate_Body; + + J, K : Nat; Info : Pending_Body_Info; + -- Start of processing for Instantiate_Bodies + begin if Serious_Errors_Detected = 0 then Expander_Active := (Operating_Mode = Opt.Generate_Code); @@ -4251,36 +4496,41 @@ package body Inline is -- A body instantiation may generate additional instantiations, so -- the following loop must scan to the end of a possibly expanding - -- set (that's why we can't simply use a FOR loop here). + -- set (that's why we cannot simply use a FOR loop here). We must + -- also capture the element lest the set be entirely reallocated. J := 0; - while J <= Pending_Instantiations.Last - and then Serious_Errors_Detected = 0 - loop - Info := Pending_Instantiations.Table (J); - - -- If the instantiation node is absent, it has been removed - -- as part of unreachable code. - - if No (Info.Inst_Node) then - null; + if Back_End_Inlining then + while J <= Called_Pending_Instantiations.Last + and then Serious_Errors_Detected = 0 + loop + K := Called_Pending_Instantiations.Table (J); + Info := Pending_Instantiations.Table (K); + Instantiate_Body (Info); - elsif Nkind (Info.Act_Decl) = N_Package_Declaration then - Instantiate_Package_Body (Info); - Add_Scope_To_Clean (Defining_Entity (Info.Act_Decl)); + J := J + 1; + end loop; - else - Instantiate_Subprogram_Body (Info); - end if; + else + while J <= Pending_Instantiations.Last + and then Serious_Errors_Detected = 0 + loop + Info := Pending_Instantiations.Table (J); + Instantiate_Body (Info); - J := J + 1; - end loop; + J := J + 1; + end loop; + end if; -- Reset the table of instantiations. Additional instantiations -- may be added through inlining, when additional bodies are -- analyzed. - Pending_Instantiations.Init; + if Back_End_Inlining then + Called_Pending_Instantiations.Init; + else + Pending_Instantiations.Init; + end if; -- We can now complete the cleanup actions of scopes that contain -- pending instantiations (skipped for generic units, since we @@ -4308,7 +4558,7 @@ package body Inline is begin Scop := Scope (E); while Scop /= Standard_Standard loop - if Ekind (Scop) in Subprogram_Kind then + if Is_Subprogram (Scop) then return True; elsif Ekind (Scop) = E_Task_Type @@ -4394,6 +4644,34 @@ package body Inline is end loop; end if; + -- Generate listing of instances inlined for the backend + + if Present (Backend_Instances) then + Count := 0; + + Elmt := First_Elmt (Backend_Instances); + while Present (Elmt) loop + Nod := Node (Elmt); + + if not In_Internal_Unit (Nod) then + Count := Count + 1; + + if Count = 1 then + Write_Str ("List of instances inlined for the backend"); + Write_Eol; + end if; + + Write_Str (" "); + Write_Int (Count); + Write_Str (":"); + Write_Location (Sloc (Nod)); + Output.Write_Eol; + end if; + + Next_Elmt (Elmt); + end loop; + end if; + -- Generate listing of subprograms passed to the backend if Present (Backend_Inlined_Subps) and then Back_End_Inlining then diff --git a/gcc/ada/inline.ads b/gcc/ada/inline.ads index 5af42f9..ed342f5 100644 --- a/gcc/ada/inline.ads +++ b/gcc/ada/inline.ads @@ -42,10 +42,8 @@ -- Inline_Always subprograms, but there are fewer restrictions on the source -- of subprograms. -with Alloc; with Opt; use Opt; with Sem; use Sem; -with Table; with Types; use Types; with Warnsw; use Warnsw; @@ -100,14 +98,6 @@ package Inline is -- Capture values of warning flags end record; - package Pending_Instantiations is new Table.Table ( - Table_Component_Type => Pending_Body_Info, - Table_Index_Type => Int, - Table_Low_Bound => 0, - Table_Initial => Alloc.Pending_Instantiations_Initial, - Table_Increment => Alloc.Pending_Instantiations_Increment, - Table_Name => "Pending_Instantiations"); - ----------------- -- Subprograms -- ----------------- diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 06afd2a..dffec14 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3861,6 +3861,12 @@ package body Sem_Ch12 is begin if Inline_Processing_Required then + -- No need to recompute the answer if we know it is positive + + if Is_Inlined (Gen_Unit) then + return True; + end if; + E := First_Entity (Gen_Unit); while Present (E) loop if Is_Subprogram (E) and then Is_Inlined (E) then @@ -3870,6 +3876,7 @@ package body Sem_Ch12 is Has_Inline_Always := True; end if; + Set_Is_Inlined (Gen_Unit); return True; end if; @@ -4425,17 +4432,6 @@ package body Sem_Ch12 is end if; if Needs_Body then - - -- Here is a defence against a ludicrous number of instantiations - -- caused by a circular set of instantiation attempts. - - if Pending_Instantiations.Last > Maximum_Instantiations then - Error_Msg_Uint_1 := UI_From_Int (Maximum_Instantiations); - Error_Msg_N ("too many instantiations, exceeds max of^", N); - Error_Msg_N ("\limit can be changed using -gnateinn switch", N); - raise Unrecoverable_Error; - end if; - -- Indicate that the enclosing scopes contain an instantiation, -- and that cleanup actions should be delayed until after the -- instance body is expanded. @@ -4633,11 +4629,10 @@ package body Sem_Ch12 is -- The instantiation results in a guaranteed ABE if Is_Known_Guaranteed_ABE (N) and then Needs_Body then - -- Do not instantiate the corresponding body because gigi cannot -- handle certain types of premature instantiations. - Pending_Instantiations.Decrement_Last; + Remove_Dead_Instance (N); -- Create completing bodies for all subprogram declarations since -- their real bodies will not be instantiated. -- cgit v1.1 From 2d1439c7ad59625fea5598dda6679c6f3be1fa1c Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Wed, 14 Aug 2019 09:52:20 +0000 Subject: [Ada] Defer processing of unknown CTW/E conditions to the back end 2019-08-14 Bob Duff gcc/ada/ * sem_prag.adb (Process_Compile_Time_Warning_Or_Error): Defer processing to the back end in all cases where the pragma's condition is not known at compile time during the front end (except in generics), as opposed to detecting 'Size attributes and the like. This ensures that we take advantage of whatever can be compile-time known after running the back end, as opposed to having the front end guess what the back end can do. Remove a little duplicated code at the call site. * gnat1drv.adb (Post_Compilation_Validation_Checks): Unlock the Elists while in Validate_Compile_Time_Warning_Errors, because it does analysis and name resolution, which sometimes involves adding Elists. From-SVN: r274466 --- gcc/ada/ChangeLog | 15 ++++++++++ gcc/ada/gnat1drv.adb | 2 ++ gcc/ada/sem_prag.adb | 77 ++++++++++------------------------------------------ 3 files changed, 31 insertions(+), 63 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6cabf26..4e7daba 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2019-08-14 Bob Duff + + * sem_prag.adb (Process_Compile_Time_Warning_Or_Error): Defer + processing to the back end in all cases where the pragma's + condition is not known at compile time during the front end + (except in generics), as opposed to detecting 'Size attributes + and the like. This ensures that we take advantage of whatever + can be compile-time known after running the back end, as opposed + to having the front end guess what the back end can do. Remove + a little duplicated code at the call site. + * gnat1drv.adb (Post_Compilation_Validation_Checks): Unlock the + Elists while in Validate_Compile_Time_Warning_Errors, because it + does analysis and name resolution, which sometimes involves + adding Elists. + 2019-08-14 Eric Botcazou * einfo.ads (Is_Called): Document new usage on E_Package diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 1f42a44..af07a06 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -1022,9 +1022,11 @@ procedure Gnat1drv is Atree.Unlock; Nlists.Unlock; + Elists.Unlock; Sem.Unlock; Sem_Prag.Validate_Compile_Time_Warning_Errors; Sem.Lock; + Elists.Lock; Nlists.Lock; Atree.Lock; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 1db39f4..f4c07a3 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -7598,46 +7598,7 @@ package body Sem_Prag is ------------------------------------------- procedure Process_Compile_Time_Warning_Or_Error is - Validation_Needed : Boolean := False; - - function Check_Node (N : Node_Id) return Traverse_Result; - -- Tree visitor that checks if N is an attribute reference that can - -- be statically computed by the back end. Validation_Needed is set - -- to True if found. - - ---------------- - -- Check_Node -- - ---------------- - - function Check_Node (N : Node_Id) return Traverse_Result is - begin - if Nkind (N) = N_Attribute_Reference - and then Is_Entity_Name (Prefix (N)) - and then not Is_Generic_Unit (Scope (Entity (Prefix (N)))) - then - declare - Attr_Id : constant Attribute_Id := - Get_Attribute_Id (Attribute_Name (N)); - begin - if Attr_Id = Attribute_Alignment - or else Attr_Id = Attribute_Size - then - Validation_Needed := True; - end if; - end; - end if; - - return OK; - end Check_Node; - - procedure Check_Expression is new Traverse_Proc (Check_Node); - - -- Local variables - Arg1x : constant Node_Id := Get_Pragma_Arg (Arg1); - - -- Start of processing for Process_Compile_Time_Warning_Or_Error - begin -- In GNATprove mode, pragmas Compile_Time_Error and -- Compile_Time_Warning are ignored, as the analyzer may not have the @@ -7655,20 +7616,18 @@ package body Sem_Prag is Check_Arg_Is_OK_Static_Expression (Arg2, Standard_String); Analyze_And_Resolve (Arg1x, Standard_Boolean); + -- If the condition is known at compile time (now), process it now. + -- Otherwise, register the expression for validation after the back + -- end has been called, because it might be known at compile time + -- then. For example, if the expression is "Record_Type'Size /= 32" + -- it might be known after the back end has determined the size of + -- Record_Type. We do not defer processing if we're inside a generic + -- unit, because we will have more information in the instances. + if Compile_Time_Known_Value (Arg1x) then Process_Compile_Time_Warning_Or_Error (N, Sloc (Arg1)); - - -- Register the expression for its validation after the back end has - -- been called if it has occurrences of attributes Size or Alignment - -- (because they may be statically computed by the back end and hence - -- the whole expression needs to be reevaluated). - - else - Check_Expression (Arg1x); - - if Validation_Needed then - Validate_Compile_Time_Warning_Error (N); - end if; + elsif not Inside_A_Generic then + Validate_Compile_Time_Warning_Error (N); end if; end Process_Compile_Time_Warning_Or_Error; @@ -14449,25 +14408,17 @@ package body Sem_Prag is -- Processing for this pragma is shared with Psect_Object - ------------------------ - -- Compile_Time_Error -- - ------------------------ + ---------------------------------------------- + -- Compile_Time_Error, Compile_Time_Warning -- + ---------------------------------------------- -- pragma Compile_Time_Error -- (boolean_EXPRESSION, static_string_EXPRESSION); - when Pragma_Compile_Time_Error => - GNAT_Pragma; - Process_Compile_Time_Warning_Or_Error; - - -------------------------- - -- Compile_Time_Warning -- - -------------------------- - -- pragma Compile_Time_Warning -- (boolean_EXPRESSION, static_string_EXPRESSION); - when Pragma_Compile_Time_Warning => + when Pragma_Compile_Time_Error | Pragma_Compile_Time_Warning => GNAT_Pragma; Process_Compile_Time_Warning_Or_Error; -- cgit v1.1 From dba246bfabc54c9a97304f4ab65fda62bd2936c8 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Wed, 14 Aug 2019 09:52:24 +0000 Subject: [Ada] Incorrect error on inline protected function This patch fixes a bug where if a protected function has a pragma Inline, and has no local variables, and the body consists of a single extended_return_statement, and the result type is an indefinite composite subtype, and inlining is enabled, the compiler gives an error, even though the program is legal. 2019-08-14 Bob Duff gcc/ada/ * inline.adb (Check_And_Split_Unconstrained_Function): Ignore protected functions to get rid of spurious error. The transformation done by this procedure triggers legality errors in the generated code in this case. gcc/testsuite/ * gnat.dg/inline19.adb, gnat.dg/inline19.ads: New testcase. From-SVN: r274467 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/inline.adb | 14 ++++++++++++++ 2 files changed, 21 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4e7daba..4063f93 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,12 @@ 2019-08-14 Bob Duff + * inline.adb (Check_And_Split_Unconstrained_Function): Ignore + protected functions to get rid of spurious error. The + transformation done by this procedure triggers legality errors + in the generated code in this case. + +2019-08-14 Bob Duff + * sem_prag.adb (Process_Compile_Time_Warning_Or_Error): Defer processing to the back end in all cases where the pragma's condition is not known at compile time during the front end diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 05830e1..5dbd9a1 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -2041,6 +2041,8 @@ package body Inline is Original_Body : Node_Id; Body_To_Analyze : Node_Id; + -- Start of processing for Build_Body_To_Inline + begin pragma Assert (Current_Scope = Spec_Id); @@ -2448,6 +2450,18 @@ package body Inline is elsif Present (Body_To_Inline (Decl)) then return; + -- Do not generate a body to inline for protected functions, because the + -- transformation generates a call to a protected procedure, causing + -- spurious errors. We don't inline protected operations anyway, so + -- this is no loss. We might as well ignore intrinsics and foreign + -- conventions as well -- just allow Ada conventions. + + elsif not (Convention (Spec_Id) = Convention_Ada + or else Convention (Spec_Id) = Convention_Ada_Pass_By_Copy + or else Convention (Spec_Id) = Convention_Ada_Pass_By_Reference) + then + return; + -- Check excluded declarations elsif Present (Declarations (N)) -- cgit v1.1 From ebf7f0abade68c85557af4f634fe68b86c34f751 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 14 Aug 2019 09:52:29 +0000 Subject: [Ada] Further cleanup in the inlining machinery 2019-08-14 Eric Botcazou gcc/ada/ * sem_ch12.adb (Might_Inline_Subp): Rework comment and restrict the shortcut based on Is_Inlined to the back-end inlining case. From-SVN: r274468 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem_ch12.adb | 13 +++++++++---- 2 files changed, 14 insertions(+), 4 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4063f93..a507c89 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-14 Eric Botcazou + + * sem_ch12.adb (Might_Inline_Subp): Rework comment and restrict + the shortcut based on Is_Inlined to the back-end inlining case. + 2019-08-14 Bob Duff * inline.adb (Check_And_Split_Unconstrained_Function): Ignore diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index dffec14..de350b4 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3845,12 +3845,16 @@ package body Sem_Ch12 is procedure Analyze_Package_Instantiation (N : Node_Id) is Has_Inline_Always : Boolean := False; + -- Set if the generic unit contains any subprograms with Inline_Always. + -- Only relevant when back-end inlining is not enabled. function Might_Inline_Subp (Gen_Unit : Entity_Id) return Boolean; -- If inlining is active and the generic contains inlined subprograms, - -- we instantiate the body. This may cause superfluous instantiations, - -- but it is simpler than detecting the need for the body at the point - -- of inlining, when the context of the instance is not available. + -- we either instantiate the body when front-end inlining is enabled, + -- or we add a pending instantiation when back-end inlining is enabled. + -- In the former case, this may cause superfluous instantiations, but + -- in either case we need to perform the instantiation of the body in + -- the context of the instance and not in that of the point of inlining. ----------------------- -- Might_Inline_Subp -- @@ -3862,8 +3866,9 @@ package body Sem_Ch12 is begin if Inline_Processing_Required then -- No need to recompute the answer if we know it is positive + -- and back-end inlining is enabled. - if Is_Inlined (Gen_Unit) then + if Is_Inlined (Gen_Unit) and then Back_End_Inlining then return True; end if; -- cgit v1.1 From 0246fe44ac945c563cb57fdb625746293d8f8334 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Wed, 14 Aug 2019 09:52:34 +0000 Subject: [Ada] Warn about unknown condition in Compile_Time_Warning The compiler now warns if the condition in a pragma Compile_Time_Warning or Compile_Time_Error does not have a compile-time-known value. The warning is not given for pragmas in a generic template, but is given for pragmas in an instance. The -gnatw_c and -gnatw_C switches turn the warning on and off. The default is on. 2019-08-14 Bob Duff gcc/ada/ * sem_prag.ads, sem_prag.adb (Process_Compile_Time_Warning_Or_Error): In parameterless version, improve detection of whether we are in a generic unit to cover the case of an instance within a generic unit. (Process_Compile_Time_Warning_Or_Error): Rename the two-parameter version to be Validate_Compile_Time_Warning_Or_Error, and do not export it. Issue a warning if the condition is not known at compile time. The key point is that the warning must be given only for pragmas deferred to the back end, because the back end discovers additional values that are known at compile time. Previous changes in this ticket have enabled this by deferring to the back end without checking for special cases such as 'Size. (Validate_Compile_Time_Warning_Or_Error): Rename to be Defer_Compile_Time_Warning_Error_To_BE. * warnsw.ads, warnsw.adb (Warn_On_Unknown_Compile_Time_Warning): Add new switches -gnatw_c and -gnatw_C to control the above warning. * doc/gnat_ugn/building_executable_programs_with_gnat.rst: Document new switches. * gnat_ugn.texi: Regenerate. gcc/testsuite/ * gnat.dg/warn27.adb: New testcase. From-SVN: r274469 --- gcc/ada/ChangeLog | 24 ++ .../building_executable_programs_with_gnat.rst | 26 +- gcc/ada/gnat_ugn.texi | 67 +++-- gcc/ada/sem_prag.adb | 73 +++-- gcc/ada/sem_prag.ads | 8 - gcc/ada/warnsw.adb | 301 +++++++++++---------- gcc/ada/warnsw.ads | 105 +++---- 7 files changed, 360 insertions(+), 244 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a507c89..370d943 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2019-08-14 Bob Duff + + * sem_prag.ads, sem_prag.adb + (Process_Compile_Time_Warning_Or_Error): In parameterless + version, improve detection of whether we are in a generic unit + to cover the case of an instance within a generic unit. + (Process_Compile_Time_Warning_Or_Error): Rename the + two-parameter version to be + Validate_Compile_Time_Warning_Or_Error, and do not export it. + Issue a warning if the condition is not known at compile time. + The key point is that the warning must be given only for pragmas + deferred to the back end, because the back end discovers + additional values that are known at compile time. Previous + changes in this ticket have enabled this by deferring to the + back end without checking for special cases such as 'Size. + (Validate_Compile_Time_Warning_Or_Error): Rename to be + Defer_Compile_Time_Warning_Error_To_BE. + * warnsw.ads, warnsw.adb (Warn_On_Unknown_Compile_Time_Warning): + Add new switches -gnatw_c and -gnatw_C to control the above + warning. + * doc/gnat_ugn/building_executable_programs_with_gnat.rst: + Document new switches. + * gnat_ugn.texi: Regenerate. + 2019-08-14 Eric Botcazou * sem_ch12.adb (Might_Inline_Subp): Rework comment and restrict diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst index beceb51..913d6b9 100644 --- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst +++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst @@ -2972,7 +2972,7 @@ of the pragma in the :title:`GNAT_Reference_manual`). component for which no component clause is present. -.. index:: -gnatwC (gcc) +.. index:: -gnatw.C (gcc) :switch:`-gnatw.C` *Suppress warnings on missing component clauses.* @@ -2981,6 +2981,30 @@ of the pragma in the :title:`GNAT_Reference_manual`). missing a component clause in the situation described above. +.. index:: -gnatw_c (gcc) + +:switch:`-gnatw_c` + *Activate warnings on unknown condition in Compile_Time_Warning.* + + .. index:: Compile_Time_Warning + .. index:: Compile_Time_Error + + This switch activates warnings on a pragma Compile_Time_Warning + or Compile_Time_Error whose condition has a value that is not + known at compile time. + The default is that such warnings are generated. + + +.. index:: -gnatw_C (gcc) + +:switch:`-gnatw_C` + *Suppress warnings on missing component clauses.* + + This switch supresses warnings on a pragma Compile_Time_Warning + or Compile_Time_Error whose condition has a value that is not + known at compile time. + + .. index:: -gnatwd (gcc) :switch:`-gnatwd` diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 5f73ab7..3e0c857 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -21,7 +21,7 @@ @copying @quotation -GNAT User's Guide for Native Platforms , Jul 31, 2019 +GNAT User's Guide for Native Platforms , Aug 01, 2019 AdaCore @@ -11208,7 +11208,7 @@ majority, but not all, of the components. A warning is given for each component for which no component clause is present. @end table -@geindex -gnatwC (gcc) +@geindex -gnatw.C (gcc) @table @asis @@ -11221,6 +11221,39 @@ This switch suppresses warnings for record components that are missing a component clause in the situation described above. @end table +@geindex -gnatw_c (gcc) + + +@table @asis + +@item @code{-gnatw_c} + +@emph{Activate warnings on unknown condition in Compile_Time_Warning.} + +@geindex Compile_Time_Warning + +@geindex Compile_Time_Error + +This switch activates warnings on a pragma Compile_Time_Warning +or Compile_Time_Error whose condition has a value that is not +known at compile time. +The default is that such warnings are generated. +@end table + +@geindex -gnatw_C (gcc) + + +@table @asis + +@item @code{-gnatw_C} + +@emph{Suppress warnings on missing component clauses.} + +This switch supresses warnings on a pragma Compile_Time_Warning +or Compile_Time_Error whose condition has a value that is not +known at compile time. +@end table + @geindex -gnatwd (gcc) @@ -20919,7 +20952,6 @@ This section presents several topics related to program performance. It first describes some of the tradeoffs that need to be considered and some of the techniques for making your program run faster. - It then documents the unused subprogram/data elimination feature, which can reduce the size of program executables. @@ -22274,9 +22306,8 @@ appropriate options. @geindex Checks (overflow) - @node Overflow Check Handling in GNAT,Performing Dimensionality Analysis in GNAT,Improving Performance,GNAT and Program Execution -@anchor{gnat_ugn/gnat_and_program_execution id50}@anchor{169}@anchor{gnat_ugn/gnat_and_program_execution overflow-check-handling-in-gnat}@anchor{27} +@anchor{gnat_ugn/gnat_and_program_execution id45}@anchor{169}@anchor{gnat_ugn/gnat_and_program_execution overflow-check-handling-in-gnat}@anchor{27} @section Overflow Check Handling in GNAT @@ -22292,7 +22323,7 @@ This section explains how to control the handling of overflow checks. @end menu @node Background,Management of Overflows in GNAT,,Overflow Check Handling in GNAT -@anchor{gnat_ugn/gnat_and_program_execution id51}@anchor{1bb}@anchor{gnat_ugn/gnat_and_program_execution background}@anchor{1bc} +@anchor{gnat_ugn/gnat_and_program_execution id46}@anchor{1bb}@anchor{gnat_ugn/gnat_and_program_execution background}@anchor{1bc} @subsection Background @@ -22418,7 +22449,7 @@ exception raised because of the intermediate overflow (and we really would prefer this precondition to be considered True at run time). @node Management of Overflows in GNAT,Specifying the Desired Mode,Background,Overflow Check Handling in GNAT -@anchor{gnat_ugn/gnat_and_program_execution management-of-overflows-in-gnat}@anchor{1bd}@anchor{gnat_ugn/gnat_and_program_execution id52}@anchor{1be} +@anchor{gnat_ugn/gnat_and_program_execution id47}@anchor{1bd}@anchor{gnat_ugn/gnat_and_program_execution management-of-overflows-in-gnat}@anchor{1be} @subsection Management of Overflows in GNAT @@ -22532,7 +22563,7 @@ out in the normal manner (with infinite values always failing all range checks). @node Specifying the Desired Mode,Default Settings,Management of Overflows in GNAT,Overflow Check Handling in GNAT -@anchor{gnat_ugn/gnat_and_program_execution specifying-the-desired-mode}@anchor{f8}@anchor{gnat_ugn/gnat_and_program_execution id53}@anchor{1bf} +@anchor{gnat_ugn/gnat_and_program_execution specifying-the-desired-mode}@anchor{f8}@anchor{gnat_ugn/gnat_and_program_execution id48}@anchor{1bf} @subsection Specifying the Desired Mode @@ -22656,7 +22687,7 @@ causing all intermediate operations to be computed using the base type (@code{STRICT} mode). @node Default Settings,Implementation Notes,Specifying the Desired Mode,Overflow Check Handling in GNAT -@anchor{gnat_ugn/gnat_and_program_execution id54}@anchor{1c0}@anchor{gnat_ugn/gnat_and_program_execution default-settings}@anchor{1c1} +@anchor{gnat_ugn/gnat_and_program_execution id49}@anchor{1c0}@anchor{gnat_ugn/gnat_and_program_execution default-settings}@anchor{1c1} @subsection Default Settings @@ -22703,7 +22734,7 @@ checking, but it has no effect on the method used for computing intermediate results. @node Implementation Notes,,Default Settings,Overflow Check Handling in GNAT -@anchor{gnat_ugn/gnat_and_program_execution id55}@anchor{1c2}@anchor{gnat_ugn/gnat_and_program_execution implementation-notes}@anchor{1c3} +@anchor{gnat_ugn/gnat_and_program_execution implementation-notes}@anchor{1c2}@anchor{gnat_ugn/gnat_and_program_execution id50}@anchor{1c3} @subsection Implementation Notes @@ -22751,7 +22782,7 @@ platforms for which @code{Long_Long_Integer} is 64-bits (nearly all GNAT platforms). @node Performing Dimensionality Analysis in GNAT,Stack Related Facilities,Overflow Check Handling in GNAT,GNAT and Program Execution -@anchor{gnat_ugn/gnat_and_program_execution id56}@anchor{16a}@anchor{gnat_ugn/gnat_and_program_execution performing-dimensionality-analysis-in-gnat}@anchor{28} +@anchor{gnat_ugn/gnat_and_program_execution performing-dimensionality-analysis-in-gnat}@anchor{28}@anchor{gnat_ugn/gnat_and_program_execution id51}@anchor{16a} @section Performing Dimensionality Analysis in GNAT @@ -23138,7 +23169,7 @@ passing (the dimension vector for the actual parameter must be equal to the dimension vector for the formal parameter). @node Stack Related Facilities,Memory Management Issues,Performing Dimensionality Analysis in GNAT,GNAT and Program Execution -@anchor{gnat_ugn/gnat_and_program_execution id57}@anchor{16b}@anchor{gnat_ugn/gnat_and_program_execution stack-related-facilities}@anchor{29} +@anchor{gnat_ugn/gnat_and_program_execution stack-related-facilities}@anchor{29}@anchor{gnat_ugn/gnat_and_program_execution id52}@anchor{16b} @section Stack Related Facilities @@ -23154,7 +23185,7 @@ particular, it deals with dynamic and static stack usage measurements. @end menu @node Stack Overflow Checking,Static Stack Usage Analysis,,Stack Related Facilities -@anchor{gnat_ugn/gnat_and_program_execution id58}@anchor{1c4}@anchor{gnat_ugn/gnat_and_program_execution stack-overflow-checking}@anchor{f4} +@anchor{gnat_ugn/gnat_and_program_execution id53}@anchor{1c4}@anchor{gnat_ugn/gnat_and_program_execution stack-overflow-checking}@anchor{f4} @subsection Stack Overflow Checking @@ -23199,7 +23230,7 @@ Consequently, to modify the size of the environment task please refer to your operating system documentation. @node Static Stack Usage Analysis,Dynamic Stack Usage Analysis,Stack Overflow Checking,Stack Related Facilities -@anchor{gnat_ugn/gnat_and_program_execution static-stack-usage-analysis}@anchor{f5}@anchor{gnat_ugn/gnat_and_program_execution id59}@anchor{1c5} +@anchor{gnat_ugn/gnat_and_program_execution id54}@anchor{1c5}@anchor{gnat_ugn/gnat_and_program_execution static-stack-usage-analysis}@anchor{f5} @subsection Static Stack Usage Analysis @@ -23248,7 +23279,7 @@ subprogram whose stack usage might be larger than the specified amount of bytes. The wording is in keeping with the qualifier documented above. @node Dynamic Stack Usage Analysis,,Static Stack Usage Analysis,Stack Related Facilities -@anchor{gnat_ugn/gnat_and_program_execution dynamic-stack-usage-analysis}@anchor{122}@anchor{gnat_ugn/gnat_and_program_execution id60}@anchor{1c6} +@anchor{gnat_ugn/gnat_and_program_execution id55}@anchor{1c6}@anchor{gnat_ugn/gnat_and_program_execution dynamic-stack-usage-analysis}@anchor{122} @subsection Dynamic Stack Usage Analysis @@ -23327,7 +23358,7 @@ The package @code{GNAT.Task_Stack_Usage} provides facilities to get stack-usage reports at run time. See its body for the details. @node Memory Management Issues,,Stack Related Facilities,GNAT and Program Execution -@anchor{gnat_ugn/gnat_and_program_execution id61}@anchor{16c}@anchor{gnat_ugn/gnat_and_program_execution memory-management-issues}@anchor{2a} +@anchor{gnat_ugn/gnat_and_program_execution id56}@anchor{16c}@anchor{gnat_ugn/gnat_and_program_execution memory-management-issues}@anchor{2a} @section Memory Management Issues @@ -23343,7 +23374,7 @@ incorrect uses of access values (including 'dangling references'). @end menu @node Some Useful Memory Pools,The GNAT Debug Pool Facility,,Memory Management Issues -@anchor{gnat_ugn/gnat_and_program_execution id62}@anchor{1c7}@anchor{gnat_ugn/gnat_and_program_execution some-useful-memory-pools}@anchor{1c8} +@anchor{gnat_ugn/gnat_and_program_execution id57}@anchor{1c7}@anchor{gnat_ugn/gnat_and_program_execution some-useful-memory-pools}@anchor{1c8} @subsection Some Useful Memory Pools @@ -23424,7 +23455,7 @@ for T1'Storage_Size use 10_000; @end quotation @node The GNAT Debug Pool Facility,,Some Useful Memory Pools,Memory Management Issues -@anchor{gnat_ugn/gnat_and_program_execution id63}@anchor{1c9}@anchor{gnat_ugn/gnat_and_program_execution the-gnat-debug-pool-facility}@anchor{1ca} +@anchor{gnat_ugn/gnat_and_program_execution id58}@anchor{1c9}@anchor{gnat_ugn/gnat_and_program_execution the-gnat-debug-pool-facility}@anchor{1ca} @subsection The GNAT Debug Pool Facility diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index f4c07a3..035b0ee 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -299,11 +299,20 @@ package body Sem_Prag is -- pragma. Entity name for unit and its parents is taken from item in -- previous with_clause that mentions the unit. - procedure Validate_Compile_Time_Warning_Error (N : Node_Id); + procedure Validate_Compile_Time_Warning_Or_Error + (N : Node_Id; + Eloc : Source_Ptr); + -- Common processing for Compile_Time_Error and Compile_Time_Warning of + -- pragma N. Called when the pragma is processed as part of its regular + -- analysis but also called after calling the back end to validate these + -- pragmas for size and alignment appropriateness. + + procedure Defer_Compile_Time_Warning_Error_To_BE (N : Node_Id); -- N is a pragma Compile_Time_Error or Compile_Warning_Error whose boolean - -- expression is not known at compile time. This procedure makes an entry - -- in a table. The actual checking is performed by Validate_Compile_Time_ - -- Warning_Errors, which is invoked after calling the back end. + -- expression is not known at compile time during the front end. This + -- procedure makes an entry in a table. The actual checking is performed by + -- Validate_Compile_Time_Warning_Errors, which is invoked after calling the + -- back end. Dummy : Integer := 0; pragma Volatile (Dummy); @@ -323,13 +332,13 @@ package body Sem_Prag is -- pragma in the source program, a breakpoint on rv catches this place in -- the source, allowing convenient stepping to the point of interest. - --------------------------------------------------- - -- Table for Validate_Compile_Time_Warning_Error -- - --------------------------------------------------- + ------------------------------------------------------ + -- Table for Defer_Compile_Time_Warning_Error_To_BE -- + ------------------------------------------------------ -- The following table collects pragmas Compile_Time_Error and Compile_ -- Time_Warning for validation. Entries are made by calls to subprogram - -- Validate_Compile_Time_Warning_Error, and the call to the procedure + -- Defer_Compile_Time_Warning_Error_To_BE, and the call to the procedure -- Validate_Compile_Time_Warning_Errors does the actual error checking -- and posting of warning and error messages. The reason for this delayed -- processing is to take advantage of back-annotations of attributes size @@ -7598,6 +7607,7 @@ package body Sem_Prag is ------------------------------------------- procedure Process_Compile_Time_Warning_Or_Error is + P : Node_Id := Parent (N); Arg1x : constant Node_Id := Get_Pragma_Arg (Arg1); begin -- In GNATprove mode, pragmas Compile_Time_Error and @@ -7616,18 +7626,29 @@ package body Sem_Prag is Check_Arg_Is_OK_Static_Expression (Arg2, Standard_String); Analyze_And_Resolve (Arg1x, Standard_Boolean); - -- If the condition is known at compile time (now), process it now. + -- If the condition is known at compile time (now), validate it now. -- Otherwise, register the expression for validation after the back -- end has been called, because it might be known at compile time -- then. For example, if the expression is "Record_Type'Size /= 32" -- it might be known after the back end has determined the size of - -- Record_Type. We do not defer processing if we're inside a generic + -- Record_Type. We do not defer validation if we're inside a generic -- unit, because we will have more information in the instances. if Compile_Time_Known_Value (Arg1x) then - Process_Compile_Time_Warning_Or_Error (N, Sloc (Arg1)); - elsif not Inside_A_Generic then - Validate_Compile_Time_Warning_Error (N); + Validate_Compile_Time_Warning_Or_Error (N, Sloc (Arg1)); + else + while Present (P) and then Nkind (P) not in N_Generic_Declaration + loop + if Nkind_In (P, N_Package_Body, N_Subprogram_Body) then + P := Corresponding_Spec (P); + else + P := Parent (P); + end if; + end loop; + + if No (P) then + Defer_Compile_Time_Warning_Error_To_BE (N); + end if; end if; end Process_Compile_Time_Warning_Or_Error; @@ -31419,11 +31440,11 @@ package body Sem_Prag is end Process_Compilation_Unit_Pragmas; - ------------------------------------------- - -- Process_Compile_Time_Warning_Or_Error -- - ------------------------------------------- + -------------------------------------------- + -- Validate_Compile_Time_Warning_Or_Error -- + -------------------------------------------- - procedure Process_Compile_Time_Warning_Or_Error + procedure Validate_Compile_Time_Warning_Or_Error (N : Node_Id; Eloc : Source_Ptr) is @@ -31530,8 +31551,16 @@ package body Sem_Prag is end loop; end; end if; + + -- Arg1x is not known at compile time, so issue a warning. This can + -- happen only if the pragma's processing was deferred until after the + -- back end is run (see Process_Compile_Time_Warning_Or_Error). + -- Note that the warning control switch applies to both pragmas. + + elsif Warn_On_Unknown_Compile_Time_Warning then + Error_Msg_N ("?condition is not known at compile time", Arg1x); end if; - end Process_Compile_Time_Warning_Or_Error; + end Validate_Compile_Time_Warning_Or_Error; ------------------------------------ -- Record_Possible_Body_Reference -- @@ -32094,17 +32123,17 @@ package body Sem_Prag is end Test_Case_Arg; ----------------------------------------- - -- Validate_Compile_Time_Warning_Error -- + -- Defer_Compile_Time_Warning_Error_To_BE -- ----------------------------------------- - procedure Validate_Compile_Time_Warning_Error (N : Node_Id) is + procedure Defer_Compile_Time_Warning_Error_To_BE (N : Node_Id) is Arg1 : constant Node_Id := First (Pragma_Argument_Associations (N)); begin Compile_Time_Warnings_Errors.Append (New_Val => CTWE_Entry'(Eloc => Sloc (Arg1), Scope => Current_Scope, Prag => N)); - end Validate_Compile_Time_Warning_Error; + end Defer_Compile_Time_Warning_Error_To_BE; ------------------------------------------ -- Validate_Compile_Time_Warning_Errors -- @@ -32158,7 +32187,7 @@ package body Sem_Prag is begin Set_Scope (T.Scope); Reset_Analyzed_Flags (T.Prag); - Process_Compile_Time_Warning_Or_Error (T.Prag, T.Eloc); + Validate_Compile_Time_Warning_Or_Error (T.Prag, T.Eloc); Unset_Scope (T.Scope); end; end loop; diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads index 4978299..88c103a 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -499,14 +499,6 @@ package Sem_Prag is -- Name_uInvariant, and Name_uType_Invariant (_Pre, _Post, _Invariant, -- and _Type_Invariant). - procedure Process_Compile_Time_Warning_Or_Error - (N : Node_Id; - Eloc : Source_Ptr); - -- Common processing for Compile_Time_Error and Compile_Time_Warning of - -- pragma N. Called when the pragma is processed as part of its regular - -- analysis but also called after calling the back end to validate these - -- pragmas for size and alignment appropriateness. - procedure Process_Compilation_Unit_Pragmas (N : Node_Id); -- Called at the start of processing compilation unit N to deal with any -- special issues regarding pragmas. In particular, we have to deal with diff --git a/gcc/ada/warnsw.adb b/gcc/ada/warnsw.adb index 219d440..a731907 100644 --- a/gcc/ada/warnsw.adb +++ b/gcc/ada/warnsw.adb @@ -43,53 +43,54 @@ package body Warnsw is procedure All_Warnings (Setting : Boolean) is begin - Address_Clause_Overlay_Warnings := Setting; - Check_Unreferenced := Setting; - Check_Unreferenced_Formals := Setting; - Check_Withs := Setting; - Constant_Condition_Warnings := Setting; - Elab_Warnings := Setting; - Implementation_Unit_Warnings := Setting; - Ineffective_Inline_Warnings := Setting; - List_Body_Required_Info := Setting; - List_Inherited_Aspects := Setting; - Warn_On_Ada_2005_Compatibility := Setting; - Warn_On_Ada_2012_Compatibility := Setting; - Warn_On_All_Unread_Out_Parameters := Setting; - Warn_On_Anonymous_Allocators := Setting; - Warn_On_Assertion_Failure := Setting; - Warn_On_Assumed_Low_Bound := Setting; - Warn_On_Atomic_Synchronization := Setting; - Warn_On_Bad_Fixed_Value := Setting; - Warn_On_Biased_Representation := Setting; - Warn_On_Constant := Setting; - Warn_On_Deleted_Code := Setting; - Warn_On_Dereference := Setting; - Warn_On_Export_Import := Setting; - Warn_On_Hiding := Setting; - Warn_On_Late_Primitives := Setting; - Warn_On_Modified_Unread := Setting; - Warn_On_No_Value_Assigned := Setting; - Warn_On_Non_Local_Exception := Setting; - Warn_On_Object_Renames_Function := Setting; - Warn_On_Obsolescent_Feature := Setting; - Warn_On_Overlap := Setting; - Warn_On_Overridden_Size := Setting; - Warn_On_Parameter_Order := Setting; - Warn_On_Questionable_Layout := Setting; - Warn_On_Questionable_Missing_Parens := Setting; - Warn_On_Record_Holes := Setting; - Warn_On_Redundant_Constructs := Setting; - Warn_On_Reverse_Bit_Order := Setting; - Warn_On_Size_Alignment := Setting; - Warn_On_Standard_Redefinition := Setting; - Warn_On_Suspicious_Contract := Setting; - Warn_On_Suspicious_Modulus_Value := Setting; - Warn_On_Unchecked_Conversion := Setting; - Warn_On_Unordered_Enumeration_Type := Setting; - Warn_On_Unrecognized_Pragma := Setting; - Warn_On_Unrepped_Components := Setting; - Warn_On_Warnings_Off := Setting; + Address_Clause_Overlay_Warnings := Setting; + Check_Unreferenced := Setting; + Check_Unreferenced_Formals := Setting; + Check_Withs := Setting; + Constant_Condition_Warnings := Setting; + Elab_Warnings := Setting; + Implementation_Unit_Warnings := Setting; + Ineffective_Inline_Warnings := Setting; + List_Body_Required_Info := Setting; + List_Inherited_Aspects := Setting; + Warn_On_Ada_2005_Compatibility := Setting; + Warn_On_Ada_2012_Compatibility := Setting; + Warn_On_All_Unread_Out_Parameters := Setting; + Warn_On_Anonymous_Allocators := Setting; + Warn_On_Assertion_Failure := Setting; + Warn_On_Assumed_Low_Bound := Setting; + Warn_On_Atomic_Synchronization := Setting; + Warn_On_Bad_Fixed_Value := Setting; + Warn_On_Biased_Representation := Setting; + Warn_On_Constant := Setting; + Warn_On_Deleted_Code := Setting; + Warn_On_Dereference := Setting; + Warn_On_Export_Import := Setting; + Warn_On_Hiding := Setting; + Warn_On_Late_Primitives := Setting; + Warn_On_Modified_Unread := Setting; + Warn_On_No_Value_Assigned := Setting; + Warn_On_Non_Local_Exception := Setting; + Warn_On_Object_Renames_Function := Setting; + Warn_On_Obsolescent_Feature := Setting; + Warn_On_Overlap := Setting; + Warn_On_Overridden_Size := Setting; + Warn_On_Parameter_Order := Setting; + Warn_On_Questionable_Layout := Setting; + Warn_On_Questionable_Missing_Parens := Setting; + Warn_On_Record_Holes := Setting; + Warn_On_Redundant_Constructs := Setting; + Warn_On_Reverse_Bit_Order := Setting; + Warn_On_Size_Alignment := Setting; + Warn_On_Standard_Redefinition := Setting; + Warn_On_Suspicious_Contract := Setting; + Warn_On_Suspicious_Modulus_Value := Setting; + Warn_On_Unchecked_Conversion := Setting; + Warn_On_Unknown_Compile_Time_Warning := Setting; + Warn_On_Unordered_Enumeration_Type := Setting; + Warn_On_Unrecognized_Pragma := Setting; + Warn_On_Unrepped_Components := Setting; + Warn_On_Warnings_Off := Setting; end All_Warnings; ---------------------- @@ -98,103 +99,105 @@ package body Warnsw is procedure Restore_Warnings (W : Warning_Record) is begin - Address_Clause_Overlay_Warnings := + Address_Clause_Overlay_Warnings := W.Address_Clause_Overlay_Warnings; - Check_Unreferenced := + Check_Unreferenced := W.Check_Unreferenced; - Check_Unreferenced_Formals := + Check_Unreferenced_Formals := W.Check_Unreferenced_Formals; - Check_Withs := + Check_Withs := W.Check_Withs; - Constant_Condition_Warnings := + Constant_Condition_Warnings := W.Constant_Condition_Warnings; - Elab_Warnings := + Elab_Warnings := W.Elab_Warnings; - Elab_Info_Messages := + Elab_Info_Messages := W.Elab_Info_Messages; - Implementation_Unit_Warnings := + Implementation_Unit_Warnings := W.Implementation_Unit_Warnings; - Ineffective_Inline_Warnings := + Ineffective_Inline_Warnings := W.Ineffective_Inline_Warnings; - List_Body_Required_Info := + List_Body_Required_Info := W.List_Body_Required_Info; - List_Inherited_Aspects := + List_Inherited_Aspects := W.List_Inherited_Aspects; - No_Warn_On_Non_Local_Exception := + No_Warn_On_Non_Local_Exception := W.No_Warn_On_Non_Local_Exception; - Warning_Doc_Switch := + Warning_Doc_Switch := W.Warning_Doc_Switch; - Warn_On_Ada_2005_Compatibility := + Warn_On_Ada_2005_Compatibility := W.Warn_On_Ada_2005_Compatibility; - Warn_On_Ada_2012_Compatibility := + Warn_On_Ada_2012_Compatibility := W.Warn_On_Ada_2012_Compatibility; - Warn_On_All_Unread_Out_Parameters := + Warn_On_All_Unread_Out_Parameters := W.Warn_On_All_Unread_Out_Parameters; - Warn_On_Anonymous_Allocators := + Warn_On_Anonymous_Allocators := W.Warn_On_Anonymous_Allocators; - Warn_On_Assertion_Failure := + Warn_On_Assertion_Failure := W.Warn_On_Assertion_Failure; - Warn_On_Assumed_Low_Bound := + Warn_On_Assumed_Low_Bound := W.Warn_On_Assumed_Low_Bound; - Warn_On_Atomic_Synchronization := + Warn_On_Atomic_Synchronization := W.Warn_On_Atomic_Synchronization; - Warn_On_Bad_Fixed_Value := + Warn_On_Bad_Fixed_Value := W.Warn_On_Bad_Fixed_Value; - Warn_On_Biased_Representation := + Warn_On_Biased_Representation := W.Warn_On_Biased_Representation; - Warn_On_Constant := + Warn_On_Constant := W.Warn_On_Constant; - Warn_On_Deleted_Code := + Warn_On_Deleted_Code := W.Warn_On_Deleted_Code; - Warn_On_Dereference := + Warn_On_Dereference := W.Warn_On_Dereference; - Warn_On_Export_Import := + Warn_On_Export_Import := W.Warn_On_Export_Import; - Warn_On_Hiding := + Warn_On_Hiding := W.Warn_On_Hiding; - Warn_On_Late_Primitives := + Warn_On_Late_Primitives := W.Warn_On_Late_Primitives; - Warn_On_Modified_Unread := + Warn_On_Modified_Unread := W.Warn_On_Modified_Unread; - Warn_On_No_Value_Assigned := + Warn_On_No_Value_Assigned := W.Warn_On_No_Value_Assigned; - Warn_On_Non_Local_Exception := + Warn_On_Non_Local_Exception := W.Warn_On_Non_Local_Exception; - Warn_On_Object_Renames_Function := + Warn_On_Object_Renames_Function := W.Warn_On_Object_Renames_Function; - Warn_On_Obsolescent_Feature := + Warn_On_Obsolescent_Feature := W.Warn_On_Obsolescent_Feature; - Warn_On_Overlap := + Warn_On_Overlap := W.Warn_On_Overlap; - Warn_On_Overridden_Size := + Warn_On_Overridden_Size := W.Warn_On_Overridden_Size; - Warn_On_Parameter_Order := + Warn_On_Parameter_Order := W.Warn_On_Parameter_Order; - Warn_On_Questionable_Layout := + Warn_On_Questionable_Layout := W.Warn_On_Questionable_Layout; - Warn_On_Questionable_Missing_Parens := + Warn_On_Questionable_Missing_Parens := W.Warn_On_Questionable_Missing_Parens; - Warn_On_Record_Holes := + Warn_On_Record_Holes := W.Warn_On_Record_Holes; - Warn_On_Redundant_Constructs := + Warn_On_Redundant_Constructs := W.Warn_On_Redundant_Constructs; - Warn_On_Reverse_Bit_Order := + Warn_On_Reverse_Bit_Order := W.Warn_On_Reverse_Bit_Order; - Warn_On_Size_Alignment := + Warn_On_Size_Alignment := W.Warn_On_Size_Alignment; - Warn_On_Standard_Redefinition := + Warn_On_Standard_Redefinition := W.Warn_On_Standard_Redefinition; - Warn_On_Suspicious_Contract := + Warn_On_Suspicious_Contract := W.Warn_On_Suspicious_Contract; - Warn_On_Unchecked_Conversion := + Warn_On_Unchecked_Conversion := W.Warn_On_Unchecked_Conversion; - Warn_On_Unordered_Enumeration_Type := + Warn_On_Unknown_Compile_Time_Warning := + W.Warn_On_Unknown_Compile_Time_Warning; + Warn_On_Unordered_Enumeration_Type := W.Warn_On_Unordered_Enumeration_Type; - Warn_On_Unrecognized_Pragma := + Warn_On_Unrecognized_Pragma := W.Warn_On_Unrecognized_Pragma; - Warn_On_Unrepped_Components := + Warn_On_Unrepped_Components := W.Warn_On_Unrepped_Components; - Warn_On_Warnings_Off := + Warn_On_Warnings_Off := W.Warn_On_Warnings_Off; end Restore_Warnings; @@ -206,103 +209,105 @@ package body Warnsw is W : Warning_Record; begin - W.Address_Clause_Overlay_Warnings := + W.Address_Clause_Overlay_Warnings := Address_Clause_Overlay_Warnings; - W.Check_Unreferenced := + W.Check_Unreferenced := Check_Unreferenced; - W.Check_Unreferenced_Formals := + W.Check_Unreferenced_Formals := Check_Unreferenced_Formals; - W.Check_Withs := + W.Check_Withs := Check_Withs; - W.Constant_Condition_Warnings := + W.Constant_Condition_Warnings := Constant_Condition_Warnings; - W.Elab_Info_Messages := + W.Elab_Info_Messages := Elab_Info_Messages; - W.Elab_Warnings := + W.Elab_Warnings := Elab_Warnings; - W.Implementation_Unit_Warnings := + W.Implementation_Unit_Warnings := Implementation_Unit_Warnings; - W.Ineffective_Inline_Warnings := + W.Ineffective_Inline_Warnings := Ineffective_Inline_Warnings; - W.List_Body_Required_Info := + W.List_Body_Required_Info := List_Body_Required_Info; - W.List_Inherited_Aspects := + W.List_Inherited_Aspects := List_Inherited_Aspects; - W.No_Warn_On_Non_Local_Exception := + W.No_Warn_On_Non_Local_Exception := No_Warn_On_Non_Local_Exception; - W.Warning_Doc_Switch := + W.Warning_Doc_Switch := Warning_Doc_Switch; - W.Warn_On_Ada_2005_Compatibility := + W.Warn_On_Ada_2005_Compatibility := Warn_On_Ada_2005_Compatibility; - W.Warn_On_Ada_2012_Compatibility := + W.Warn_On_Ada_2012_Compatibility := Warn_On_Ada_2012_Compatibility; - W.Warn_On_All_Unread_Out_Parameters := + W.Warn_On_All_Unread_Out_Parameters := Warn_On_All_Unread_Out_Parameters; - W.Warn_On_Anonymous_Allocators := + W.Warn_On_Anonymous_Allocators := Warn_On_Anonymous_Allocators; - W.Warn_On_Assertion_Failure := + W.Warn_On_Assertion_Failure := Warn_On_Assertion_Failure; - W.Warn_On_Assumed_Low_Bound := + W.Warn_On_Assumed_Low_Bound := Warn_On_Assumed_Low_Bound; - W.Warn_On_Atomic_Synchronization := + W.Warn_On_Atomic_Synchronization := Warn_On_Atomic_Synchronization; - W.Warn_On_Bad_Fixed_Value := + W.Warn_On_Bad_Fixed_Value := Warn_On_Bad_Fixed_Value; - W.Warn_On_Biased_Representation := + W.Warn_On_Biased_Representation := Warn_On_Biased_Representation; - W.Warn_On_Constant := + W.Warn_On_Constant := Warn_On_Constant; - W.Warn_On_Deleted_Code := + W.Warn_On_Deleted_Code := Warn_On_Deleted_Code; - W.Warn_On_Dereference := + W.Warn_On_Dereference := Warn_On_Dereference; - W.Warn_On_Export_Import := + W.Warn_On_Export_Import := Warn_On_Export_Import; - W.Warn_On_Hiding := + W.Warn_On_Hiding := Warn_On_Hiding; - W.Warn_On_Late_Primitives := + W.Warn_On_Late_Primitives := Warn_On_Late_Primitives; - W.Warn_On_Modified_Unread := + W.Warn_On_Modified_Unread := Warn_On_Modified_Unread; - W.Warn_On_No_Value_Assigned := + W.Warn_On_No_Value_Assigned := Warn_On_No_Value_Assigned; - W.Warn_On_Non_Local_Exception := + W.Warn_On_Non_Local_Exception := Warn_On_Non_Local_Exception; - W.Warn_On_Object_Renames_Function := + W.Warn_On_Object_Renames_Function := Warn_On_Object_Renames_Function; - W.Warn_On_Obsolescent_Feature := + W.Warn_On_Obsolescent_Feature := Warn_On_Obsolescent_Feature; - W.Warn_On_Overlap := + W.Warn_On_Overlap := Warn_On_Overlap; - W.Warn_On_Overridden_Size := + W.Warn_On_Overridden_Size := Warn_On_Overridden_Size; - W.Warn_On_Parameter_Order := + W.Warn_On_Parameter_Order := Warn_On_Parameter_Order; - W.Warn_On_Questionable_Layout := + W.Warn_On_Questionable_Layout := Warn_On_Questionable_Layout; - W.Warn_On_Questionable_Missing_Parens := + W.Warn_On_Questionable_Missing_Parens := Warn_On_Questionable_Missing_Parens; - W.Warn_On_Record_Holes := + W.Warn_On_Record_Holes := Warn_On_Record_Holes; - W.Warn_On_Redundant_Constructs := + W.Warn_On_Redundant_Constructs := Warn_On_Redundant_Constructs; - W.Warn_On_Reverse_Bit_Order := + W.Warn_On_Reverse_Bit_Order := Warn_On_Reverse_Bit_Order; - W.Warn_On_Size_Alignment := + W.Warn_On_Size_Alignment := Warn_On_Size_Alignment; - W.Warn_On_Standard_Redefinition := + W.Warn_On_Standard_Redefinition := Warn_On_Standard_Redefinition; - W.Warn_On_Suspicious_Contract := + W.Warn_On_Suspicious_Contract := Warn_On_Suspicious_Contract; - W.Warn_On_Unchecked_Conversion := + W.Warn_On_Unchecked_Conversion := Warn_On_Unchecked_Conversion; - W.Warn_On_Unordered_Enumeration_Type := + W.Warn_On_Unknown_Compile_Time_Warning := + Warn_On_Unknown_Compile_Time_Warning; + W.Warn_On_Unordered_Enumeration_Type := Warn_On_Unordered_Enumeration_Type; - W.Warn_On_Unrecognized_Pragma := + W.Warn_On_Unrecognized_Pragma := Warn_On_Unrecognized_Pragma; - W.Warn_On_Unrepped_Components := + W.Warn_On_Unrepped_Components := Warn_On_Unrepped_Components; - W.Warn_On_Warnings_Off := + W.Warn_On_Warnings_Off := Warn_On_Warnings_Off; return W; end Save_Warnings; @@ -489,6 +494,12 @@ package body Warnsw is when 'A' => Warn_On_Anonymous_Allocators := False; + when 'c' => + Warn_On_Unknown_Compile_Time_Warning := True; + + when 'C' => + Warn_On_Unknown_Compile_Time_Warning := False; + when others => if Ignore_Unrecognized_VWY_Switches then Write_Line ("unrecognized switch -gnatw_" & C & " ignored"); diff --git a/gcc/ada/warnsw.ads b/gcc/ada/warnsw.ads index 422f8df..f96c11c 100644 --- a/gcc/ada/warnsw.ads +++ b/gcc/ada/warnsw.ads @@ -48,6 +48,10 @@ package Warnsw is -- Warn when tagged type public primitives are defined after its private -- extensions. + Warn_On_Unknown_Compile_Time_Warning : Boolean := True; + -- Warn on a pragma Compile_Time_Warning or Compile_Time_Error whose + -- condition has a value that is not known at compile time. + Warn_On_Overridden_Size : Boolean := False; -- Warn when explicit record component clause or array component_size -- clause specifies a size that overrides a size for the type which was @@ -80,56 +84,57 @@ package Warnsw is -- Type used to save and restore warnings type Warning_Record is record - Address_Clause_Overlay_Warnings : Boolean; - Check_Unreferenced : Boolean; - Check_Unreferenced_Formals : Boolean; - Check_Withs : Boolean; - Constant_Condition_Warnings : Boolean; - Elab_Info_Messages : Boolean; - Elab_Warnings : Boolean; - Implementation_Unit_Warnings : Boolean; - Ineffective_Inline_Warnings : Boolean; - List_Body_Required_Info : Boolean; - List_Inherited_Aspects : Boolean; - No_Warn_On_Non_Local_Exception : Boolean; - Warning_Doc_Switch : Boolean; - Warn_On_Ada_2005_Compatibility : Boolean; - Warn_On_Ada_2012_Compatibility : Boolean; - Warn_On_All_Unread_Out_Parameters : Boolean; - Warn_On_Anonymous_Allocators : Boolean; - Warn_On_Assertion_Failure : Boolean; - Warn_On_Assumed_Low_Bound : Boolean; - Warn_On_Atomic_Synchronization : Boolean; - Warn_On_Bad_Fixed_Value : Boolean; - Warn_On_Biased_Representation : Boolean; - Warn_On_Constant : Boolean; - Warn_On_Deleted_Code : Boolean; - Warn_On_Dereference : Boolean; - Warn_On_Export_Import : Boolean; - Warn_On_Hiding : Boolean; - Warn_On_Late_Primitives : Boolean; - Warn_On_Modified_Unread : Boolean; - Warn_On_No_Value_Assigned : Boolean; - Warn_On_Non_Local_Exception : Boolean; - Warn_On_Object_Renames_Function : Boolean; - Warn_On_Obsolescent_Feature : Boolean; - Warn_On_Overlap : Boolean; - Warn_On_Overridden_Size : Boolean; - Warn_On_Parameter_Order : Boolean; - Warn_On_Questionable_Layout : Boolean; - Warn_On_Questionable_Missing_Parens : Boolean; - Warn_On_Record_Holes : Boolean; - Warn_On_Redundant_Constructs : Boolean; - Warn_On_Reverse_Bit_Order : Boolean; - Warn_On_Size_Alignment : Boolean; - Warn_On_Standard_Redefinition : Boolean; - Warn_On_Suspicious_Contract : Boolean; - Warn_On_Suspicious_Modulus_Value : Boolean; - Warn_On_Unchecked_Conversion : Boolean; - Warn_On_Unordered_Enumeration_Type : Boolean; - Warn_On_Unrecognized_Pragma : Boolean; - Warn_On_Unrepped_Components : Boolean; - Warn_On_Warnings_Off : Boolean; + Address_Clause_Overlay_Warnings : Boolean; + Check_Unreferenced : Boolean; + Check_Unreferenced_Formals : Boolean; + Check_Withs : Boolean; + Constant_Condition_Warnings : Boolean; + Elab_Info_Messages : Boolean; + Elab_Warnings : Boolean; + Implementation_Unit_Warnings : Boolean; + Ineffective_Inline_Warnings : Boolean; + List_Body_Required_Info : Boolean; + List_Inherited_Aspects : Boolean; + No_Warn_On_Non_Local_Exception : Boolean; + Warning_Doc_Switch : Boolean; + Warn_On_Ada_2005_Compatibility : Boolean; + Warn_On_Ada_2012_Compatibility : Boolean; + Warn_On_All_Unread_Out_Parameters : Boolean; + Warn_On_Anonymous_Allocators : Boolean; + Warn_On_Assertion_Failure : Boolean; + Warn_On_Assumed_Low_Bound : Boolean; + Warn_On_Atomic_Synchronization : Boolean; + Warn_On_Bad_Fixed_Value : Boolean; + Warn_On_Biased_Representation : Boolean; + Warn_On_Constant : Boolean; + Warn_On_Deleted_Code : Boolean; + Warn_On_Dereference : Boolean; + Warn_On_Export_Import : Boolean; + Warn_On_Hiding : Boolean; + Warn_On_Late_Primitives : Boolean; + Warn_On_Modified_Unread : Boolean; + Warn_On_No_Value_Assigned : Boolean; + Warn_On_Non_Local_Exception : Boolean; + Warn_On_Object_Renames_Function : Boolean; + Warn_On_Obsolescent_Feature : Boolean; + Warn_On_Overlap : Boolean; + Warn_On_Overridden_Size : Boolean; + Warn_On_Parameter_Order : Boolean; + Warn_On_Questionable_Layout : Boolean; + Warn_On_Questionable_Missing_Parens : Boolean; + Warn_On_Record_Holes : Boolean; + Warn_On_Redundant_Constructs : Boolean; + Warn_On_Reverse_Bit_Order : Boolean; + Warn_On_Size_Alignment : Boolean; + Warn_On_Standard_Redefinition : Boolean; + Warn_On_Suspicious_Contract : Boolean; + Warn_On_Suspicious_Modulus_Value : Boolean; + Warn_On_Unchecked_Conversion : Boolean; + Warn_On_Unknown_Compile_Time_Warning : Boolean; + Warn_On_Unordered_Enumeration_Type : Boolean; + Warn_On_Unrecognized_Pragma : Boolean; + Warn_On_Unrepped_Components : Boolean; + Warn_On_Warnings_Off : Boolean; end record; function Save_Warnings return Warning_Record; -- cgit v1.1 From 022c9dfe1f92a51da29a70a95b7af2f0541b6ab0 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Wed, 14 Aug 2019 09:52:39 +0000 Subject: [Ada] Do not crash with -gnatR3 on Ghost aspects 2019-08-14 Ed Schonberg gcc/ada/ * sem_aux.adb (Next_Rep_Item): If a node in the rep chain involves a Ghost aspect it may have been replaced by a null statement; use the original node to find next Rep_Item. * repinfo.adb (List_Entities): Do not list an Ignored Ghost_Entity, for which information may have been deleted. From-SVN: r274470 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/repinfo.adb | 1 + gcc/ada/sem_aux.adb | 6 ++++++ 3 files changed, 15 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 370d943..1c869e1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-08-14 Ed Schonberg + + * sem_aux.adb (Next_Rep_Item): If a node in the rep chain + involves a Ghost aspect it may have been replaced by a null + statement; use the original node to find next Rep_Item. + * repinfo.adb (List_Entities): Do not list an Ignored + Ghost_Entity, for which information may have been deleted. + 2019-08-14 Bob Duff * sem_prag.ads, sem_prag.adb diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index d168e90..6f531b2 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -479,6 +479,7 @@ package body Repinfo is if Present (Ent) and then Nkind (Declaration_Node (Ent)) not in N_Renaming_Declaration + and then not Is_Ignored_Ghost_Entity (Ent) then -- If entity is a subprogram and we are listing mechanisms, -- then we need to list mechanisms for this entity. We skip this diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 71a3873..e5bd68a 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -569,6 +569,12 @@ package body Sem_Aux is elsif Entity (N) = E then return N; end if; + + -- A Ghost-related aspect, if disabled, may have been replaced by a + -- null statement. + + elsif Nkind (N) = N_Null_Statement then + N := Original_Node (N); end if; Next_Rep_Item (N); -- cgit v1.1 From 0cc1d9ad98fdabe6c577de1a83c4e12821f0c333 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 14 Aug 2019 09:52:43 +0000 Subject: [Ada] Further cleanup in inlining machinery No practical functional changes. 2019-08-14 Eric Botcazou gcc/ada/ * inline.adb (Add_Pending_Instantiation): Use greater-or-equal in the comparison against the maximum number of instantiations. From-SVN: r274471 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/inline.adb | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1c869e1..a8de811 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-14 Eric Botcazou + + * inline.adb (Add_Pending_Instantiation): Use greater-or-equal + in the comparison against the maximum number of instantiations. + 2019-08-14 Ed Schonberg * sem_aux.adb (Next_Rep_Item): If a node in the rep chain diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 5dbd9a1..15cec51 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -794,7 +794,7 @@ package body Inline is -- Here is a defense against a ludicrous number of instantiations -- caused by a circular set of instantiation attempts. - if Pending_Instantiations.Last > Maximum_Instantiations then + if Pending_Instantiations.Last >= Maximum_Instantiations then Error_Msg_Uint_1 := UI_From_Int (Maximum_Instantiations); Error_Msg_N ("too many instantiations, exceeds max of^", Inst); Error_Msg_N ("\limit can be changed using -gnateinn switch", Inst); -- cgit v1.1 From f0539a7914cba3b7de76665a74edb90e30f2dbc9 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 14 Aug 2019 09:52:48 +0000 Subject: [Ada] Further cleanup in inlining machinery This is visible if you pass a very small number by means of -gnateinn. 2019-08-14 Eric Botcazou gcc/ada/ * inline.adb (Add_Pending_Instantiation): Fix off-by-one error in the comparison against the maximum number of instantiations. From-SVN: r274472 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/inline.adb | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a8de811..61c22fd 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2019-08-14 Eric Botcazou + * inline.adb (Add_Pending_Instantiation): Fix off-by-one error + in the comparison against the maximum number of instantiations. + +2019-08-14 Eric Botcazou + * inline.adb (Add_Pending_Instantiation): Use greater-or-equal in the comparison against the maximum number of instantiations. diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 15cec51..84ad1ab 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -794,7 +794,7 @@ package body Inline is -- Here is a defense against a ludicrous number of instantiations -- caused by a circular set of instantiation attempts. - if Pending_Instantiations.Last >= Maximum_Instantiations then + if Pending_Instantiations.Last + 1 >= Maximum_Instantiations then Error_Msg_Uint_1 := UI_From_Int (Maximum_Instantiations); Error_Msg_N ("too many instantiations, exceeds max of^", Inst); Error_Msg_N ("\limit can be changed using -gnateinn switch", Inst); -- cgit v1.1 From ff0889eb4d7f34270a6cddb3351fe8ee4fc9bbe0 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Wed, 14 Aug 2019 09:52:54 +0000 Subject: [Ada] Alignment may be specified as zero An Alignment clause or an aspect_specification for Alignment may be specified as 0, which is treated the same as 1. 2019-08-14 Bob Duff gcc/ada/ * sem_ch13.adb (Get_Alignment_Value): Return 1 for Alignment 0, and do not give an error. * doc/gnat_rm/representation_clauses_and_pragmas.rst: Update the corresponding documentation. * gnat_rm.texi: Regenerate. gcc/testsuite/ * gnat.dg/alignment15.adb: New testcase. From-SVN: r274473 --- gcc/ada/ChangeLog | 8 +++++ .../gnat_rm/representation_clauses_and_pragmas.rst | 42 +++++++++++----------- gcc/ada/gnat_rm.texi | 10 +++--- gcc/ada/sem_ch13.adb | 7 +++- 4 files changed, 42 insertions(+), 25 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 61c22fd..1887705 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-08-14 Bob Duff + + * sem_ch13.adb (Get_Alignment_Value): Return 1 for Alignment 0, + and do not give an error. + * doc/gnat_rm/representation_clauses_and_pragmas.rst: Update the + corresponding documentation. + * gnat_rm.texi: Regenerate. + 2019-08-14 Eric Botcazou * inline.adb (Add_Pending_Instantiation): Fix off-by-one error diff --git a/gcc/ada/doc/gnat_rm/representation_clauses_and_pragmas.rst b/gcc/ada/doc/gnat_rm/representation_clauses_and_pragmas.rst index 82dc97c..efcdc80 100644 --- a/gcc/ada/doc/gnat_rm/representation_clauses_and_pragmas.rst +++ b/gcc/ada/doc/gnat_rm/representation_clauses_and_pragmas.rst @@ -30,9 +30,11 @@ Alignment Clauses .. index:: Alignment Clause -GNAT requires that all alignment clauses specify a power of 2, and all -default alignments are always a power of 2. The default alignment -values are as follows: +GNAT requires that all alignment clauses specify 0 or a power of 2, and +all default alignments are always a power of 2. Specifying 0 is the +same as specifying 1. + +The default alignment values are as follows: * *Elementary Types*. @@ -610,23 +612,23 @@ alignment of the type (this is true for all types). In some cases the end record; -On a typical 32-bit architecture, the X component will occupy four bytes -and the Y component will occupy one byte, for a total of 5 bytes. As a -result ``R'Value_Size`` will be 40 (bits) since this is the minimum size -required to store a value of this type. For example, it is permissible -to have a component of type R in an array whose component size is -specified to be 40 bits. - -However, ``R'Object_Size`` will be 64 (bits). The difference is due to -the alignment requirement for objects of the record type. The X -component will require four-byte alignment because that is what type -Integer requires, whereas the Y component, a Character, will only -require 1-byte alignment. Since the alignment required for X is the -greatest of all the components' alignments, that is the alignment -required for the enclosing record type, i.e., 4 bytes or 32 bits. As -indicated above, the actual object size must be rounded up so that it is -a multiple of the alignment value. Therefore, 40 bits rounded up to the -next multiple of 32 yields 64 bits. +On a typical 32-bit architecture, the X component will occupy four bytes +and the Y component will occupy one byte, for a total of 5 bytes. As a +result ``R'Value_Size`` will be 40 (bits) since this is the minimum size +required to store a value of this type. For example, it is permissible +to have a component of type R in an array whose component size is +specified to be 40 bits. + +However, ``R'Object_Size`` will be 64 (bits). The difference is due to +the alignment requirement for objects of the record type. The X +component will require four-byte alignment because that is what type +Integer requires, whereas the Y component, a Character, will only +require 1-byte alignment. Since the alignment required for X is the +greatest of all the components' alignments, that is the alignment +required for the enclosing record type, i.e., 4 bytes or 32 bits. As +indicated above, the actual object size must be rounded up so that it is +a multiple of the alignment value. Therefore, 40 bits rounded up to the +next multiple of 32 yields 64 bits. For all other types, the ``Object_Size`` and ``Value_Size`` are the same (and equivalent to the RM attribute ``Size``). diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 7de5de6..58ff6af 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -21,7 +21,7 @@ @copying @quotation -GNAT Reference Manual , Jul 31, 2019 +GNAT Reference Manual , Aug 01, 2019 AdaCore @@ -18369,9 +18369,11 @@ and this section describes the additional capabilities provided. @geindex Alignment Clause -GNAT requires that all alignment clauses specify a power of 2, and all -default alignments are always a power of 2. The default alignment -values are as follows: +GNAT requires that all alignment clauses specify 0 or a power of 2, and +all default alignments are always a power of 2. Specifying 0 is the +same as specifying 1. + +The default alignment values are as follows: @itemize * diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 8c5c424..35a295c 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -11509,7 +11509,7 @@ package body Sem_Ch13 is if Align = No_Uint then return No_Uint; - elsif Align <= 0 then + elsif Align < 0 then -- This error is suppressed in ASIS mode to allow for different ASIS -- back ends or ASIS-based tools to query the illegal clause. @@ -11520,6 +11520,11 @@ package body Sem_Ch13 is return No_Uint; + -- If Alignment is specified to be 0, we treat it the same as 1 + + elsif Align = 0 then + return Uint_1; + else for J in Int range 0 .. 64 loop declare -- cgit v1.1 From 4b0f6ee8b58dedc18192933e35f81b2b71d44fe7 Mon Sep 17 00:00:00 2001 From: Joffrey Huguet Date: Wed, 14 Aug 2019 09:52:58 +0000 Subject: [Ada] Improve performance of Containers.Functional_Base This patch modifies the implementation of Functional_Base to damp the cost of its subprograms at runtime in specific cases. Instead of copying the entire underlying array to create a new container, containers can share the same Array_Base attribute. Performance on common use cases of formal and functional containers is improved with this patch. 2019-08-14 Joffrey Huguet gcc/ada/ * libgnat/a-cofuba.ads: Add a Length attribute to type Container. Add a type Array_Base which replaces the previous Elements attribute of Container. (Content_Init): New subprogram. It is used to initialize the Base attribute of Container. * libgnat/a-cofuba.adb (Resize): New subprogram. It is used to resize the underlying array of a container if necessary. (=, <=, Find, Get, Intersection, Length, Num_Overlaps, Set, Union): Update to match changes in type declarations. (Add): Modify body to damp the time and space cost in a specific case. (Content_Init): New subprogram. It is used to initialize the Base attribute of Container. (Remove): Modify body to damp the time and space cost in a specific case. From-SVN: r274474 --- gcc/ada/ChangeLog | 18 +++++ gcc/ada/libgnat/a-cofuba.adb | 179 ++++++++++++++++++++++++++++++------------- gcc/ada/libgnat/a-cofuba.ads | 17 +++- 3 files changed, 160 insertions(+), 54 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1887705..2c4e026 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2019-08-14 Joffrey Huguet + + * libgnat/a-cofuba.ads: Add a Length attribute to type + Container. Add a type Array_Base which replaces the previous + Elements attribute of Container. + (Content_Init): New subprogram. It is used to initialize the + Base attribute of Container. + * libgnat/a-cofuba.adb (Resize): New subprogram. It is used to + resize the underlying array of a container if necessary. + (=, <=, Find, Get, Intersection, Length, Num_Overlaps, Set, + Union): Update to match changes in type declarations. + (Add): Modify body to damp the time and space cost in a specific + case. + (Content_Init): New subprogram. It is used to initialize the + Base attribute of Container. + (Remove): Modify body to damp the time and space cost in a + specific case. + 2019-08-14 Bob Duff * sem_ch13.adb (Get_Alignment_Value): Return 1 for Alignment 0, diff --git a/gcc/ada/libgnat/a-cofuba.adb b/gcc/ada/libgnat/a-cofuba.adb index bfd2a9e..5c5f488 100644 --- a/gcc/ada/libgnat/a-cofuba.adb +++ b/gcc/ada/libgnat/a-cofuba.adb @@ -30,6 +30,7 @@ ------------------------------------------------------------------------------ pragma Ada_2012; +with Ada.Unchecked_Deallocation; package body Ada.Containers.Functional_Base with SPARK_Mode => Off is @@ -47,18 +48,22 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is -- Search a container C for an element equal to E.all, returning the -- position in the underlying array. + procedure Resize (Base : Array_Base_Access); + -- Resize the underlying array if needed so that it can contain one more + -- element. + --------- -- "=" -- --------- function "=" (C1 : Container; C2 : Container) return Boolean is begin - if C1.Elements'Length /= C2.Elements'Length then + if C1.Length /= C2.Length then return False; end if; - for I in C1.Elements'Range loop - if C1.Elements (I).all /= C2.Elements (I).all then + for I in 1 .. C1.Length loop + if C1.Base.Elements (I).all /= C2.Base.Elements (I).all then return False; end if; end loop; @@ -72,8 +77,8 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is function "<=" (C1 : Container; C2 : Container) return Boolean is begin - for I in C1.Elements'Range loop - if Find (C2, C1.Elements (I)) = 0 then + for I in 1 .. C1.Length loop + if Find (C2, C1.Base.Elements (I)) = 0 then return False; end if; end loop; @@ -90,31 +95,58 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is I : Index_Type; E : Element_Type) return Container is - A : constant Element_Array_Access := - new Element_Array'(1 .. C.Elements'Last + 1 => <>); - P : Count_Type := 0; - begin - for J in 1 .. C.Elements'Last + 1 loop - if J /= To_Count (I) then - P := P + 1; - A (J) := C.Elements (P); - else - A (J) := new Element_Type'(E); - end if; - end loop; - - return Container'(Elements => A); + if To_Count (I) = C.Length + 1 and then C.Length = C.Base.Max_Length then + Resize (C.Base); + C.Base.Max_Length := C.Base.Max_Length + 1; + C.Base.Elements (C.Base.Max_Length) := new Element_Type'(E); + + return Container'(Length => C.Base.Max_Length, Base => C.Base); + else + declare + A : constant Array_Base_Access := Content_Init (C.Length); + P : Count_Type := 0; + begin + A.Max_Length := C.Length + 1; + for J in 1 .. C.Length + 1 loop + if J /= To_Count (I) then + P := P + 1; + A.Elements (J) := C.Base.Elements (P); + else + A.Elements (J) := new Element_Type'(E); + end if; + end loop; + + return Container'(Length => A.Max_Length, + Base => A); + end; + end if; end Add; + ------------------ + -- Content_Init -- + ------------------ + + function Content_Init (L : Count_Type := 0) return Array_Base_Access + is + Max_Init : constant Count_Type := 100; + Size : constant Count_Type := + (if L < Count_Type'Last - Max_Init then L + Max_Init + else Count_Type'Last); + Elements : constant Element_Array_Access := + new Element_Array'(1 .. Size => <>); + begin + return new Array_Base'(Max_Length => 0, Elements => Elements); + end Content_Init; + ---------- -- Find -- ---------- function Find (C : Container; E : access Element_Type) return Count_Type is begin - for I in C.Elements'Range loop - if C.Elements (I).all = E.all then + for I in 1 .. C.Length loop + if C.Base.Elements (I).all = E.all then return I; end if; end loop; @@ -130,34 +162,34 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is --------- function Get (C : Container; I : Index_Type) return Element_Type is - (C.Elements (To_Count (I)).all); + (C.Base.Elements (To_Count (I)).all); ------------------ -- Intersection -- ------------------ function Intersection (C1 : Container; C2 : Container) return Container is - A : constant Element_Array_Access := - new Element_Array'(1 .. Num_Overlaps (C1, C2) => <>); + L : constant Count_Type := Num_Overlaps (C1, C2); + A : constant Array_Base_Access := Content_Init (L); P : Count_Type := 0; begin - for I in C1.Elements'Range loop - if Find (C2, C1.Elements (I)) > 0 then + A.Max_Length := L; + for I in 1 .. C1.Length loop + if Find (C2, C1.Base.Elements (I)) > 0 then P := P + 1; - A (P) := C1.Elements (I); + A.Elements (P) := C1.Base.Elements (I); end if; end loop; - return Container'(Elements => A); + return Container'(Length => P, Base => A); end Intersection; ------------ -- Length -- ------------ - function Length (C : Container) return Count_Type is (C.Elements'Length); - + function Length (C : Container) return Count_Type is (C.Length); --------------------- -- Num_Overlaps -- --------------------- @@ -166,8 +198,8 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is P : Count_Type := 0; begin - for I in C1.Elements'Range loop - if Find (C2, C1.Elements (I)) > 0 then + for I in 1 .. C1.Length loop + if Find (C2, C1.Base.Elements (I)) > 0 then P := P + 1; end if; end loop; @@ -180,20 +212,60 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is ------------ function Remove (C : Container; I : Index_Type) return Container is - A : constant Element_Array_Access := - new Element_Array'(1 .. C.Elements'Last - 1 => <>); - P : Count_Type := 0; + begin + if To_Count (I) = C.Length then + return Container'(Length => C.Length - 1, Base => C.Base); + else + declare + A : constant Array_Base_Access := Content_Init (C.Length - 1); + P : Count_Type := 0; + begin + A.Max_Length := C.Length - 1; + for J in 1 .. C.Length loop + if J /= To_Count (I) then + P := P + 1; + A.Elements (P) := C.Base.Elements (J); + end if; + end loop; + + return Container'(Length => C.Length - 1, Base => A); + end; + end if; + end Remove; + + ------------ + -- Resize -- + ------------ + procedure Resize (Base : Array_Base_Access) is begin - for J in C.Elements'Range loop - if J /= To_Count (I) then - P := P + 1; - A (P) := C.Elements (J); - end if; - end loop; + if Base.Max_Length < Base.Elements'Length then + return; + end if; - return Container'(Elements => A); - end Remove; + pragma Assert (Base.Max_Length = Base.Elements'Length); + + if Base.Max_Length = Count_Type'Last then + raise Constraint_Error; + end if; + + declare + procedure Finalize is new Ada.Unchecked_Deallocation + (Object => Element_Array, + Name => Element_Array_Access_Base); + + New_Length : constant Positive_Count_Type := + (if Base.Max_Length > Count_Type'Last / 2 then Count_Type'Last + else 2 * Base.Max_Length); + Elements : constant Element_Array_Access := + new Element_Array (1 .. New_Length); + Old_Elmts : Element_Array_Access_Base := Base.Elements; + begin + Elements (1 .. Base.Max_Length) := Base.Elements.all; + Base.Elements := Elements; + Finalize (Old_Elmts); + end; + end Resize; --------- -- Set -- @@ -205,10 +277,13 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is E : Element_Type) return Container is Result : constant Container := - Container'(Elements => new Element_Array'(C.Elements.all)); + Container'(Length => C.Length, + Base => Content_Init (C.Length)); begin - Result.Elements (To_Count (I)) := new Element_Type'(E); + Result.Base.Max_Length := C.Length; + Result.Base.Elements (1 .. C.Length) := C.Base.Elements (1 .. C.Length); + Result.Base.Elements (To_Count (I)) := new Element_Type'(E); return Result; end Set; @@ -230,20 +305,20 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is declare L : constant Count_Type := Length (C1) - N + Length (C2); - A : constant Element_Array_Access := - new Element_Array' - (C1.Elements.all & (Length (C1) + 1 .. L => <>)); + A : constant Array_Base_Access := Content_Init (L); P : Count_Type := Length (C1); begin - for I in C2.Elements'Range loop - if Find (C1, C2.Elements (I)) = 0 then + A.Max_Length := L; + A.Elements (1 .. C1.Length) := C1.Base.Elements (1 .. C1.Length); + for I in 1 .. C2.Length loop + if Find (C1, C2.Base.Elements (I)) = 0 then P := P + 1; - A (P) := C2.Elements (I); + A.Elements (P) := C2.Base.Elements (I); end if; end loop; - return Container'(Elements => A); + return Container'(Length => L, Base => A); end; end Union; diff --git a/gcc/ada/libgnat/a-cofuba.ads b/gcc/ada/libgnat/a-cofuba.ads index 3010782..b693baa 100644 --- a/gcc/ada/libgnat/a-cofuba.ads +++ b/gcc/ada/libgnat/a-cofuba.ads @@ -105,13 +105,26 @@ private type Element_Array is array (Positive_Count_Type range <>) of Element_Access; - type Element_Array_Access is not null access Element_Array; + type Element_Array_Access_Base is access Element_Array; + + subtype Element_Array_Access is not null Element_Array_Access_Base; Empty_Element_Array_Access : constant Element_Array_Access := new Element_Array'(1 .. 0 => null); + type Array_Base is record + Max_Length : Count_Type; + Elements : Element_Array_Access; + end record; + + type Array_Base_Access is not null access Array_Base; + + function Content_Init (L : Count_Type := 0) return Array_Base_Access; + -- Used to initialize the content of an array base with length L + type Container is record - Elements : Element_Array_Access := Empty_Element_Array_Access; + Length : Count_Type := 0; + Base : Array_Base_Access := Content_Init; end record; end Ada.Containers.Functional_Base; -- cgit v1.1 From c9d57552ed85ddfa6b76c755855d112e4cfe277d Mon Sep 17 00:00:00 2001 From: Pierre-Marie de Rodat Date: Mon, 19 Aug 2019 08:35:17 +0000 Subject: [Ada] Define the -fdump-scos option in lang.opt 2019-08-19 Pierre-Marie de Rodat gcc/ada/ * gcc-interface/lang.opt (fdump-scos): Define. * gcc-interface/misc.c (gnat_handle_option): Handle OPT_fdump_scos. From-SVN: r274637 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/gcc-interface/lang.opt | 4 ++++ gcc/ada/gcc-interface/misc.c | 1 + 3 files changed, 11 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2c4e026..d6367e1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-19 Pierre-Marie de Rodat + + * gcc-interface/lang.opt (fdump-scos): Define. + * gcc-interface/misc.c (gnat_handle_option): Handle + OPT_fdump_scos. + 2019-08-14 Joffrey Huguet * libgnat/a-cofuba.ads: Add a Length attribute to type diff --git a/gcc/ada/gcc-interface/lang.opt b/gcc/ada/gcc-interface/lang.opt index cc9fa49..4295651 100644 --- a/gcc/ada/gcc-interface/lang.opt +++ b/gcc/ada/gcc-interface/lang.opt @@ -56,6 +56,10 @@ Wall Ada AdaWhy AdaSCIL Enable most warning messages. +fdump-scos +Ada RejectNegative Var(flag_dump_scos) Init(0) +Dump Source Coverage Obligations + k8 Driver Synonym of -gnatk8. diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index 5737165..d53374e 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -161,6 +161,7 @@ gnat_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value, case OPT_gnatO: case OPT_fRTS_: case OPT_I: + case OPT_fdump_scos: case OPT_nostdinc: case OPT_nostdlib: /* These are handled by the front-end. */ -- cgit v1.1 From 04d933fd48d7e7cbedb761d660229cac9f36fab2 Mon Sep 17 00:00:00 2001 From: Olivier Hainque Date: Mon, 19 Aug 2019 08:35:24 +0000 Subject: [Ada] Fix thinko in Acc_Loop_to_gnu This fixes a glitch introduced during the initial OpenACC work import process, causing crashes on any Acc_Parallel + Acc_Loop combination. 2019-08-19 Olivier Hainque gcc/ada/ * gcc-interface/trans.c (Acc_Loop_to_gnu): Return the openacc BIND_EXPR node we have constructed on purpose. Remove unused variable. gcc/testsuite/ * gnat.dg/openacc1.adb: New testcase. From-SVN: r274638 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/gcc-interface/trans.c | 5 +---- 2 files changed, 7 insertions(+), 4 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d6367e1..0ead307 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-19 Olivier Hainque + + * gcc-interface/trans.c (Acc_Loop_to_gnu): Return the openacc + BIND_EXPR node we have constructed on purpose. Remove unused + variable. + 2019-08-19 Pierre-Marie de Rodat * gcc-interface/lang.opt (fdump-scos): Define. diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 95991bd..6c696b9 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -3398,9 +3398,6 @@ independent_iterations_p (tree stmt_list) static tree Acc_Loop_to_gnu (Node_Id gnat_loop) { - const struct loop_info_d * const gnu_loop_info = gnu_loop_stack->last (); - tree gnu_loop_stmt = gnu_loop_info->stmt; - tree acc_loop = make_node (OACC_LOOP); tree acc_bind_expr = NULL_TREE; Node_Id cur_loop = gnat_loop; @@ -3517,7 +3514,7 @@ Acc_Loop_to_gnu (Node_Id gnat_loop) BIND_EXPR_BODY (acc_bind_expr) = acc_loop; - return gnu_loop_stmt; + return acc_bind_expr; } /* Helper for Loop_Statement_to_gnu, to translate the body of a loop not -- cgit v1.1 From a4bbe10deb69d4885baffde7fa42c0ba137e7dc8 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 19 Aug 2019 08:35:31 +0000 Subject: [Ada] Further cleanup in inlining machinery This gets rid of a small issue in the inlining machinery: under very peculiar circumstances, it would add a pending instantiation for the body of a generic package at the point of call to an inlined subprogram of the instance. That's theoritically problematic because the saved context is that of the call and not that of the instance in this case, although the strict conditions ensure that this doesn't make a real difference in practice. Now that the machinery can perform the pending instantiations on demand, we can optimistically add more of them when the instantiations are analyzed and thus remove the problematic handling at the point of call. No functional changes. 2019-08-19 Eric Botcazou gcc/ada/ * inline.adb (Add_Inlined_Body): Do not add pending instantiations. * sem_ch12.adb (Needs_Body_Instantiated): New predicate. (Analyze_Package_Instantiation): Use it to decide whether to add a pending instantiation for the body of the package. From-SVN: r274639 --- gcc/ada/ChangeLog | 8 +++++ gcc/ada/inline.adb | 37 ++++----------------- gcc/ada/sem_ch12.adb | 92 ++++++++++++++++++++++++++++++++++++++-------------- 3 files changed, 82 insertions(+), 55 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0ead307..9fc8c9e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-08-19 Eric Botcazou + + * inline.adb (Add_Inlined_Body): Do not add pending + instantiations. + * sem_ch12.adb (Needs_Body_Instantiated): New predicate. + (Analyze_Package_Instantiation): Use it to decide whether to add + a pending instantiation for the body of the package. + 2019-08-19 Olivier Hainque * gcc-interface/trans.c (Acc_Loop_to_gnu): Return the openacc diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 84ad1ab..f7bb1a9 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -510,7 +510,6 @@ package body Inline is Inst : Entity_Id; Inst_Decl : Node_Id; - Inst_Node : Node_Id; Level : Inline_Level_Type; -- Start of processing for Add_Inlined_Body @@ -609,48 +608,24 @@ package body Inline is and then Is_Generic_Instance (Inst) and then not Is_Called (Inst) then - -- Do not add a pending instantiation if the body exits - -- already, or if the instance is a compilation unit, or - -- the instance node is missing. - Inst_Decl := Unit_Declaration_Node (Inst); + + -- Do not inline the instance if the body already exists, + -- or if the instance is a compilation unit, or else if + -- the instance node is simply missing. + if Present (Corresponding_Body (Inst_Decl)) or else Nkind (Parent (Inst_Decl)) = N_Compilation_Unit or else No (Next (Inst_Decl)) then Set_Is_Called (Inst); - else - -- If the inlined call itself appears within an instance, - -- ensure that the enclosing instance body is available. - -- This is necessary because Sem_Ch12.Might_Inline_Subp - -- does not recurse into nested instantiations. - - if not Is_Inlined (Inst) and then In_Instance then - Set_Is_Inlined (Inst); - - -- The instantiation node usually follows the package - -- declaration for the instance. If the generic unit - -- has aspect specifications, they are transformed - -- into pragmas in the instance, and the instance node - -- appears after them. - - Inst_Node := Next (Inst_Decl); - - while Nkind (Inst_Node) /= N_Package_Instantiation loop - Inst_Node := Next (Inst_Node); - end loop; - - Add_Pending_Instantiation (Inst_Node, Inst_Decl); - end if; - Add_Inlined_Instance (Inst); end if; end if; end if; - -- If the unit containing E is an instance, then the instance body - -- will be analyzed in any case, see Sem_Ch12.Might_Inline_Subp. + -- If the unit containing E is an instance, nothing more to do if Is_Generic_Instance (Pack) then null; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index de350b4..5d1c824 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -240,6 +240,10 @@ package body Sem_Ch12 is -- circularity is detected, and used to abandon compilation after the -- messages have been posted. + Circularity_Detected : Boolean := False; + -- It should really be reset upon encountering a new main unit, but in + -- practice we do not use multiple main units so this is not critical. + ----------------------------------------- -- Implementation of Generic Contracts -- ----------------------------------------- @@ -352,10 +356,6 @@ package body Sem_Ch12 is -- Instantiate_Subprogram_Contract - Circularity_Detected : Boolean := False; - -- This should really be reset on encountering a new main unit, but in - -- practice we are not using multiple main units so it is not critical. - -------------------------------------------------- -- Formal packages and partial parameterization -- -------------------------------------------------- @@ -380,23 +380,23 @@ package body Sem_Ch12 is -- the generic package, and a set of declarations that map the actuals -- into local renamings, just as we do for bona fide instantiations. For -- defaulted parameters and formals with a box, we copy directly the - -- declarations of the formal into this local package. The result is a - -- a package whose visible declarations may include generic formals. This + -- declarations of the formals into this local package. The result is a + -- package whose visible declarations may include generic formals. This -- package is only used for type checking and visibility analysis, and - -- never reaches the back-end, so it can freely violate the placement + -- never reaches the back end, so it can freely violate the placement -- rules for generic formal declarations. -- The list of declarations (renamings and copies of formals) is built -- by Analyze_Associations, just as for regular instantiations. -- At the point of instantiation, conformance checking must be applied only - -- to those parameters that were specified in the formal. We perform this + -- to those parameters that were specified in the formals. We perform this -- checking by creating another internal instantiation, this one including -- only the renamings and the formals (the rest of the package spec is not -- relevant to conformance checking). We can then traverse two lists: the -- list of actuals in the instance that corresponds to the formal package, -- and the list of actuals produced for this bogus instantiation. We apply - -- the conformance rules to those actuals that are not defaulted (i.e. + -- the conformance rules to those actuals that are not defaulted, i.e. -- which still appear as generic formals. -- When we compile an instance body we must make the right parameters @@ -3849,12 +3849,17 @@ package body Sem_Ch12 is -- Only relevant when back-end inlining is not enabled. function Might_Inline_Subp (Gen_Unit : Entity_Id) return Boolean; - -- If inlining is active and the generic contains inlined subprograms, - -- we either instantiate the body when front-end inlining is enabled, - -- or we add a pending instantiation when back-end inlining is enabled. - -- In the former case, this may cause superfluous instantiations, but - -- in either case we need to perform the instantiation of the body in - -- the context of the instance and not in that of the point of inlining. + -- Return True if inlining is active and Gen_Unit contains inlined + -- subprograms. In this case, we may either instantiate the body when + -- front-end inlining is enabled, or add a pending instantiation when + -- back-end inlining is enabled. In the former case, this may cause + -- superfluous instantiations, but in either case we need to perform + -- the instantiation of the body in the context of the instance and + -- not in that of the point of inlining. + + function Needs_Body_Instantiated (Gen_Unit : Entity_Id) return Boolean; + -- Return True if Gen_Unit needs to have its body instantiated in the + -- context of N. This in particular excludes generic contexts. ----------------------- -- Might_Inline_Subp -- @@ -3892,6 +3897,52 @@ package body Sem_Ch12 is return False; end Might_Inline_Subp; + ------------------------------- + -- Needs_Body_Instantiated -- + ------------------------------- + + function Needs_Body_Instantiated (Gen_Unit : Entity_Id) return Boolean is + begin + -- No need to instantiate bodies in generic units + + if Is_Generic_Unit (Cunit_Entity (Main_Unit)) then + return False; + end if; + + -- If the instantiation is in the main unit, then the body is needed + + if Is_In_Main_Unit (N) then + return True; + end if; + + -- If not, then again no need to instantiate bodies in generic units + + if Is_Generic_Unit (Cunit_Entity (Get_Code_Unit (N))) then + return False; + end if; + + -- Here we have a special handling for back-end inlining: if the + -- instantiation is not a compilation unit, then we want to have + -- its body instantiated. The reason is that Might_Inline_Subp + -- does not catch all the cases (since it does not recurse into + -- nested packages) so this avoids the need to patch things up + -- at a later stage. Moreover the instantiations that are not + -- compilation units are only performed on demand when back-end + -- inlining is enabled, so this causes very little extra work. + + if Nkind (Parent (N)) /= N_Compilation_Unit + and then Inline_Processing_Required + and then Back_End_Inlining + then + return True; + end if; + + -- We want to have the bodies instantiated in non-main units if + -- they might contribute inlined subprograms. + + return Might_Inline_Subp (Gen_Unit); + end Needs_Body_Instantiated; + -- Local declarations Gen_Id : constant Node_Id := Name (N); @@ -4256,9 +4307,7 @@ package body Sem_Ch12 is end if; -- Save the instantiation node for a subsequent instantiation of the - -- body if there is one and the main unit is not generic, and either - -- we are generating code for this main unit, or the instantiation - -- contains inlined subprograms and is not done in a generic unit. + -- body if there is one and it needs to be instantiated here. -- We instantiate the body only if we are generating code, or if we -- are generating cross-reference information, or if we are building @@ -4354,12 +4403,7 @@ package body Sem_Ch12 is (Unit_Requires_Body (Gen_Unit) or else Enclosing_Body_Present or else Present (Corresponding_Body (Gen_Decl))) - and then not Is_Generic_Unit (Cunit_Entity (Main_Unit)) - and then (Is_In_Main_Unit (N) - or else (Might_Inline_Subp (Gen_Unit) - and then - not Is_Generic_Unit - (Cunit_Entity (Get_Code_Unit (N))))) + and then Needs_Body_Instantiated (Gen_Unit) and then not Is_Actual_Pack and then not Inline_Now and then (Operating_Mode = Generate_Code -- cgit v1.1 From c811dd91e184db204073d04c28ed107888b39518 Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Mon, 19 Aug 2019 08:35:35 +0000 Subject: [Ada] Do not skip non-aliasing checking when inlining in GNATprove When code is inlinined for proof in the special mode for GNATprove, Ada rules about non-aliasing should still be checked. Now fixed. There is no impact on compilation. 2019-08-19 Yannick Moy gcc/ada/ * sem_res.adb (Resolve_Call): Check non-aliasing rules before GNATprove inlining. From-SVN: r274640 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem_res.adb | 8 ++++---- 2 files changed, 9 insertions(+), 4 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9fc8c9e..9222a98 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-19 Yannick Moy + + * sem_res.adb (Resolve_Call): Check non-aliasing rules before + GNATprove inlining. + 2019-08-19 Eric Botcazou * inline.adb (Add_Inlined_Body): Do not add pending diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index b27171f..8f2e358 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -6968,6 +6968,10 @@ package body Sem_Res is Build_Call_Marker (N); + Mark_Use_Clauses (Subp); + + Warn_On_Overlapping_Actuals (Nam, N); + -- In GNATprove mode, expansion is disabled, but we want to inline some -- subprograms to facilitate formal verification. Indirect calls through -- a subprogram type or within a generic cannot be inlined. Inlining is @@ -7116,10 +7120,6 @@ package body Sem_Res is end if; end if; end if; - - Mark_Use_Clauses (Subp); - - Warn_On_Overlapping_Actuals (Nam, N); end Resolve_Call; ----------------------------- -- cgit v1.1 From d9ef7b974555fe62f3e93835720edde6ff889ac5 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 19 Aug 2019 08:35:40 +0000 Subject: [Ada] Representation clause for derived enumeration type is mishandled This patch fixes an old-standing problem with premature freezing. When a derived type declaration includes a constraint, we generate a subtype declaration of an anonymous base type, with the constraint given in the original type declaration, Conceptually, the bounds are converted to the new base type, and this conversion freezes (prematurely) that base type, when the bounds are simply literals. As a result, a representation clause for the derived type is then rejected or ignared. This procedure recognizes the simple case of literal bounds in derived enumeration type declarations, which allows us to indicate that the conversions are not freeze points, and the subsequent representation clause can be accepted. 2019-08-19 Ed Schonberg gcc/ada/ * sem_ch3.adb (Derived_Enumeration_Type): Do no freeze anonymous base type if the bounds in the derived type declaration are literals of the type. gcc/testsuite/ * gnat.dg/rep_clause9.adb: New testcase. From-SVN: r274641 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/sem_ch3.adb | 25 ++++++++++++++++++++++++- 2 files changed, 30 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9222a98..78e1743 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-19 Ed Schonberg + + * sem_ch3.adb (Derived_Enumeration_Type): Do no freeze anonymous + base type if the bounds in the derived type declaration are + literals of the type. + 2019-08-19 Yannick Moy * sem_res.adb (Resolve_Call): Check non-aliasing rules before diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 218aa0c..1b4c42d 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -7135,6 +7135,27 @@ package body Sem_Ch3 is Parent_Type : Entity_Id; Derived_Type : Entity_Id) is + function Bound_Belongs_To_Type (B : Node_Id) return Boolean; + -- When the type declaration includes a constraint, we generate + -- a subtype declaration of an anonymous base type, with the constraint + -- given in the original type declaration. Conceptually, the bounds + -- are converted to the new base type, and this conversion freezes + -- (prematurely) that base type, when the bounds are simply literals. + -- As a result, a representation clause for the derived type is then + -- rejected or ignored. This procedure recognizes the simple case of + -- literal bounds, which allows us to indicate that the conversions + -- are not freeze points, and the subsequent representation clause + -- can be accepted. + -- A similar approach might be used to resolve the long-standing + -- problem of premature freezing of derived numeric types ??? + + function Bound_Belongs_To_Type (B : Node_Id) return Boolean is + begin + return Nkind (B) = N_Type_Conversion + and then Is_Entity_Name (Expression (B)) + and then Ekind (Entity (Expression (B))) = E_Enumeration_Literal; + end Bound_Belongs_To_Type; + Loc : constant Source_Ptr := Sloc (N); Def : constant Node_Id := Type_Definition (N); Indic : constant Node_Id := Subtype_Indication (Def); @@ -7350,7 +7371,9 @@ package body Sem_Ch3 is -- However, if the type inherits predicates the expressions will -- be elaborated earlier and must freeze. - if Nkind (Indic) /= N_Subtype_Indication + if (Nkind (Indic) /= N_Subtype_Indication + or else + (Bound_Belongs_To_Type (Lo) and then Bound_Belongs_To_Type (Hi))) and then not Has_Predicates (Derived_Type) then Set_Must_Not_Freeze (Lo); -- cgit v1.1 From b1d7f6fe2beffb06c9745e1afba73a6aa7fa9dbd Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 19 Aug 2019 08:35:44 +0000 Subject: [Ada] Opt: clean up left-overs of earlier implementation in comment 2019-08-19 Eric Botcazou gcc/ada/ * opt.ads: Clean up left-overs of earlier implementation in comment: From-SVN: r274642 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/opt.ads | 6 +++--- 2 files changed, 8 insertions(+), 3 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 78e1743..3163ad1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-19 Eric Botcazou + + * opt.ads: Clean up left-overs of earlier implementation in + comment: + 2019-08-19 Ed Schonberg * sem_ch3.adb (Derived_Enumeration_Type): Do no freeze anonymous diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 4d3e87e..3158899 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -501,7 +501,7 @@ package Opt is type Distribution_Stub_Mode_Type is -- GNAT (No_Stubs, - -- Normal mode, no generation/compilation of distribution stubs + -- Normal mode, no generation of distribution stubs Generate_Receiver_Stub_Body, -- The unit being compiled is the RCI body, and the compiler will @@ -513,8 +513,8 @@ package Opt is Distribution_Stub_Mode : Distribution_Stub_Mode_Type := No_Stubs; -- GNAT - -- This enumeration variable indicates the five states of distribution - -- annex stub generation/compilation. + -- This enumeration variable indicates the three states of distribution + -- annex stub generation. Do_Not_Execute : Boolean := False; -- GNATMAKE -- cgit v1.1 From 123f02156122ea13f3bfabdef2b6385a25527158 Mon Sep 17 00:00:00 2001 From: Joffrey Huguet Date: Mon, 19 Aug 2019 08:35:49 +0000 Subject: [Ada] Add formal function parameter equality to SPARK containers This patch adds a formal function parameter "=" (L, R : Element_Type) to SPARK containers. The equality that is used by default for Element_Type after this patch is the primitive equality and not the predefined any more. It also allows to use any function with the appropriate signature for the equality function. 2019-08-19 Joffrey Huguet gcc/ada/ * libgnat/a-cfdlli.ads, libgnat/a-cfhama.ads, libgnat/a-cfinve.ads, libgnat/a-cforma.ads, libgnat/a-cofove.ads, libgnat/a-cofuma.ads, libgnat/a-cofuve.ads: Add formal function parameter "=" (L, R : Element_Type) to the generic packages. From-SVN: r274643 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/libgnat/a-cfdlli.ads | 1 + gcc/ada/libgnat/a-cfhama.ads | 1 + gcc/ada/libgnat/a-cfinve.ads | 1 + gcc/ada/libgnat/a-cforma.ads | 1 + gcc/ada/libgnat/a-cofove.ads | 2 ++ gcc/ada/libgnat/a-cofuma.ads | 1 + gcc/ada/libgnat/a-cofuve.ads | 1 + 8 files changed, 16 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3163ad1..8ba0dc4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-08-19 Joffrey Huguet + + * libgnat/a-cfdlli.ads, libgnat/a-cfhama.ads, + libgnat/a-cfinve.ads, libgnat/a-cforma.ads, + libgnat/a-cofove.ads, libgnat/a-cofuma.ads, + libgnat/a-cofuve.ads: Add formal function parameter "=" (L, R : + Element_Type) to the generic packages. + 2019-08-19 Eric Botcazou * opt.ads: Clean up left-overs of earlier implementation in diff --git a/gcc/ada/libgnat/a-cfdlli.ads b/gcc/ada/libgnat/a-cfdlli.ads index f6bf8c9..b8df023 100644 --- a/gcc/ada/libgnat/a-cfdlli.ads +++ b/gcc/ada/libgnat/a-cfdlli.ads @@ -34,6 +34,7 @@ with Ada.Containers.Functional_Maps; generic type Element_Type is private; + with function "=" (Left, Right : Element_Type) return Boolean is <>; package Ada.Containers.Formal_Doubly_Linked_Lists with SPARK_Mode diff --git a/gcc/ada/libgnat/a-cfhama.ads b/gcc/ada/libgnat/a-cfhama.ads index 643a949..c4e8221 100644 --- a/gcc/ada/libgnat/a-cfhama.ads +++ b/gcc/ada/libgnat/a-cfhama.ads @@ -59,6 +59,7 @@ generic with function Equivalent_Keys (Left : Key_Type; Right : Key_Type) return Boolean is "="; + with function "=" (Left, Right : Element_Type) return Boolean is <>; package Ada.Containers.Formal_Hashed_Maps with SPARK_Mode diff --git a/gcc/ada/libgnat/a-cfinve.ads b/gcc/ada/libgnat/a-cfinve.ads index e359f8d..87940d2 100644 --- a/gcc/ada/libgnat/a-cfinve.ads +++ b/gcc/ada/libgnat/a-cfinve.ads @@ -38,6 +38,7 @@ with Ada.Containers.Functional_Vectors; generic type Index_Type is range <>; type Element_Type (<>) is private; + with function "=" (Left, Right : Element_Type) return Boolean is <>; Max_Size_In_Storage_Elements : Natural; -- Maximum size of Vector elements in bytes. This has the same meaning as -- in Ada.Containers.Bounded_Holders, with the same restrictions. Note that diff --git a/gcc/ada/libgnat/a-cforma.ads b/gcc/ada/libgnat/a-cforma.ads index d76cc76..a13bce4 100644 --- a/gcc/ada/libgnat/a-cforma.ads +++ b/gcc/ada/libgnat/a-cforma.ads @@ -58,6 +58,7 @@ generic type Element_Type is private; with function "<" (Left, Right : Key_Type) return Boolean is <>; + with function "=" (Left, Right : Element_Type) return Boolean is <>; package Ada.Containers.Formal_Ordered_Maps with SPARK_Mode diff --git a/gcc/ada/libgnat/a-cofove.ads b/gcc/ada/libgnat/a-cofove.ads index 5b62664..b23c661 100644 --- a/gcc/ada/libgnat/a-cofove.ads +++ b/gcc/ada/libgnat/a-cofove.ads @@ -40,6 +40,8 @@ with Ada.Containers.Functional_Vectors; generic type Index_Type is range <>; type Element_Type is private; + with function "=" (Left, Right : Element_Type) return Boolean is <>; + package Ada.Containers.Formal_Vectors with SPARK_Mode is diff --git a/gcc/ada/libgnat/a-cofuma.ads b/gcc/ada/libgnat/a-cofuma.ads index 8a71cb7..bf6e5a8 100644 --- a/gcc/ada/libgnat/a-cofuma.ads +++ b/gcc/ada/libgnat/a-cofuma.ads @@ -39,6 +39,7 @@ generic with function Equivalent_Keys (Left : Key_Type; Right : Key_Type) return Boolean is "="; + with function "=" (Left, Right : Element_Type) return Boolean is <>; Enable_Handling_Of_Equivalence : Boolean := True; -- This constant should only be set to False when no particular handling diff --git a/gcc/ada/libgnat/a-cofuve.ads b/gcc/ada/libgnat/a-cofuve.ads index 4f80450..804d7b0 100644 --- a/gcc/ada/libgnat/a-cofuve.ads +++ b/gcc/ada/libgnat/a-cofuve.ads @@ -38,6 +38,7 @@ generic -- should have at least one more element at the low end than Index_Type. type Element_Type (<>) is private; + with function "=" (Left, Right : Element_Type) return Boolean is <>; package Ada.Containers.Functional_Vectors with SPARK_Mode is -- cgit v1.1 From ef1c6c0e5499a83be7f86ccf64e3eb8814137cc9 Mon Sep 17 00:00:00 2001 From: Claire Dross Date: Mon, 19 Aug 2019 08:35:53 +0000 Subject: [Ada] Allow reading a borrowed object inside a call to a pledge function No impact on regular compilation. 2019-08-19 Claire Dross gcc/ada/ * sem_spark.ads, sem_spark.adb (Is_Pledge_Function): New parameter of the generic. Function used to decide whether a function is a pledge function. (Check_Not_Borrowed): Disable check inside the second parameter of a pledge function for the path borrowed by the first parameter. Also disable checks for entities inside a Global contract. From-SVN: r274644 --- gcc/ada/ChangeLog | 10 ++++++++++ gcc/ada/sem_spark.adb | 36 ++++++++++++++++++++++++++++++++++++ gcc/ada/sem_spark.ads | 3 +++ 3 files changed, 49 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8ba0dc4..d06fd4e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2019-08-19 Claire Dross + + * sem_spark.ads, sem_spark.adb (Is_Pledge_Function): New + parameter of the generic. Function used to decide whether a + function is a pledge function. + (Check_Not_Borrowed): Disable check inside the second parameter + of a pledge function for the path borrowed by the first + parameter. Also disable checks for entities inside a Global + contract. + 2019-08-19 Joffrey Huguet * libgnat/a-cfdlli.ads, libgnat/a-cfhama.ads, diff --git a/gcc/ada/sem_spark.adb b/gcc/ada/sem_spark.adb index b0686b7..30e1426 100644 --- a/gcc/ada/sem_spark.adb +++ b/gcc/ada/sem_spark.adb @@ -5008,13 +5008,49 @@ package body Sem_SPARK is Get_First_Key (Current_Borrowers); Var : Entity_Id; Borrowed : Node_Id; + B_Pledge : Entity_Id := Empty; begin + -- Search for a call to a pledge function or a global pragma in + -- the parents of Expr. + + declare + Call : Node_Id := Expr; + begin + while Present (Call) + and then + (Nkind (Call) /= N_Function_Call + or else not Is_Pledge_Function (Get_Called_Entity (Call))) + loop + -- Do not check for borrowed objects in global contracts + -- ??? However we should keep these objects in the borrowed + -- state when verifying the subprogram so that we can make + -- sure that they are only read inside pledges. + -- ??? There is probably a better way to disable checking of + -- borrows inside global contracts. + + if Nkind (Call) = N_Pragma + and then Get_Pragma_Id (Pragma_Name (Call)) = Pragma_Global + then + return; + end if; + + Call := Parent (Call); + end loop; + + if Present (Call) + and then Nkind (First_Actual (Call)) in N_Has_Entity + then + B_Pledge := Entity (First_Actual (Call)); + end if; + end; + while Key.Present loop Var := Key.K; Borrowed := Get (Current_Borrowers, Var); if Is_Prefix_Or_Almost (Pref => Borrowed, Expr => Expr) + and then Var /= B_Pledge and then Emit_Messages then Error_Msg_Sloc := Sloc (Borrowed); diff --git a/gcc/ada/sem_spark.ads b/gcc/ada/sem_spark.ads index 7c16281..0aaa115 100644 --- a/gcc/ada/sem_spark.ads +++ b/gcc/ada/sem_spark.ads @@ -150,6 +150,9 @@ generic with function Emit_Messages return Boolean; -- Return True when error messages should be emitted. + with function Is_Pledge_Function (E : Entity_Id) return Boolean; + -- Return True if E is annotated with a pledge annotation + package Sem_SPARK is function Is_Legal (N : Node_Id) return Boolean; -- cgit v1.1 From 086734aed9adb3e46f362db83e9ea31571778b54 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Mon, 19 Aug 2019 08:35:58 +0000 Subject: [Ada] Minor refactorings 2019-08-19 Piotr Trojanek gcc/ada/ * sem_ch12.adb (Get_Unit_Instantiation_Node): Simplify Nkind_In membership test. * sem.adb (Depends_On_Main): Whitespace cleanup; only assign a local variable if needed. From-SVN: r274645 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/sem.adb | 8 +++----- gcc/ada/sem_ch12.adb | 5 +---- 3 files changed, 11 insertions(+), 9 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d06fd4e..a2e9037 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-08-19 Piotr Trojanek + + * sem_ch12.adb (Get_Unit_Instantiation_Node): Simplify Nkind_In + membership test. + * sem.adb (Depends_On_Main): Whitespace cleanup; only assign a + local variable if needed. + 2019-08-19 Claire Dross * sem_spark.ads, sem_spark.adb (Is_Pledge_Function): New diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 9b6b335..2e99531 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -1729,16 +1729,14 @@ package body Sem is MCU : constant Node_Id := Unit (Main_CU); begin - CL := First (Context_Items (CU)); - -- Problem does not arise with main subprograms - if - not Nkind_In (MCU, N_Package_Body, N_Package_Declaration) - then + if not Nkind_In (MCU, N_Package_Body, N_Package_Declaration) then return False; end if; + CL := First (Context_Items (CU)); + while Present (CL) loop if Nkind (CL) = N_With_Clause and then Library_Unit (CL) = Main_CU diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 5d1c824..e94fc21 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -8953,10 +8953,7 @@ package body Sem_Ch12 is Decl := Unit_Declaration_Node (Corresponding_Body (Decl)); end if; - if Nkind_In (Original_Node (Decl), N_Function_Instantiation, - N_Package_Instantiation, - N_Procedure_Instantiation) - then + if Nkind (Original_Node (Decl)) in N_Generic_Instantiation then return Original_Node (Decl); else return Unit (Parent (Decl)); -- cgit v1.1 From d41f5c1facb17bd231fe4dbc122d105585281487 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Mon, 19 Aug 2019 08:36:02 +0000 Subject: [Ada] Document missing gnatmetric switches 2019-08-19 Bob Duff gcc/ada/ * doc/gnat_ugn/gnat_utility_programs.rst: Document missing metrics switches. From-SVN: r274646 --- gcc/ada/ChangeLog | 5 +++ gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst | 57 +++++++++++++++++++++++++- 2 files changed, 61 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a2e9037..f059578 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-19 Bob Duff + + * doc/gnat_ugn/gnat_utility_programs.rst: Document missing + metrics switches. + 2019-08-19 Piotr Trojanek * sem_ch12.adb (Get_Unit_Instantiation_Node): Simplify Nkind_In diff --git a/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst b/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst index db0a82e..56d4869 100644 --- a/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst +++ b/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst @@ -2107,6 +2107,14 @@ Alternatively, you may run the script using the following command line: task bodies, entry bodies and statement sequences in package bodies. + :switch:`--lines-spark` + Report the number of lines written in SPARK. + + + :switch:`--no-lines-spark` + Do not report the number of lines written in SPARK. + + .. _Syntax_Metrics_Control: Syntax Metrics Control @@ -2293,6 +2301,53 @@ Alternatively, you may run the script using the following command line: Do not report the number of subprogram parameters + .. _Contract_Metrics_Control: + + Contract Metrics Control + ^^^^^^^^^^^^^^^^^^^^^^^^ + + .. index:: Contract metrics control in gnatmetric + + :switch:`--contract-all` + Report all the contract metrics + + + :switch:`--no-contract-all` + Do not report any of the contract metrics + + + :switch:`--contract` + Report the number of public subprograms with contracts + + + :switch:`--no-contract` + Do not report the number of public subprograms with contracts + + + :switch:`--post` + Report the number of public subprograms with postconditions + + + :switch:`--no-post` + Do not report the number of public subprograms with postconditions + + + :switch:`--contract-complete` + Report the number of public subprograms with complete contracts + + + :switch:`--no-contract-complete` + Do not report the number of public subprograms with complete contracts + + + :switch:`--contract-all` + Report the McCabe complexity of public subprograms + + + :switch:`--no-contract-all` + Do not report the McCabe complexity of public subprograms + + .. _Complexity_Metrics_Control: Complexity Metrics Control @@ -2384,7 +2439,7 @@ Alternatively, you may run the script using the following command line: :switch:`--no-complexity-all` - Do not report any of complexity metrics + Do not report any of the complexity metrics :switch:`--complexity-cyclomatic` -- cgit v1.1 From 27b2fbc95cea0512e71a4cd3090e68ae2bf4fe1d Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 19 Aug 2019 08:36:07 +0000 Subject: [Ada] Fix internal error on subprogram instantiation with -gnatzc This fixes a fallout of the recent change keeping the Is_Generic_Instance flag on the wrapper package built for the instantiation of a generic subprogram. There is no need to visit the Instance_Spec of an N_Subprogram_Instantiation node anymore because the regular processing for an N_Package_Declaration node now does the job for instantiations of generic subprograms. The following subprogram must compile again quietly with -gnatzc: with Gen_Proc; package RCI is pragma Remote_Call_Interface; procedure Inst_Proc is new Gen_Proc; procedure P (S : String); end RCI; generic procedure Gen_Proc (S : String); pragma Remote_Call_Interface (Gen_Proc); with Ada.Text_IO; use Ada.Text_IO; procedure Gen_Proc (S : String) is begin Put_Line ("Gen_Proc called: " & S); end Gen_Proc; 2019-08-19 Eric Botcazou gcc/ada/ * exp_dist.adb (Build_Package_Stubs): Do not specifically visit the declarations of an N_Subprogram_Instantiation node. From-SVN: r274647 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/exp_dist.adb | 16 ++-------------- 2 files changed, 7 insertions(+), 14 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f059578..e1342f4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-19 Eric Botcazou + + * exp_dist.adb (Build_Package_Stubs): Do not specifically visit + the declarations of an N_Subprogram_Instantiation node. + 2019-08-19 Bob Duff * doc/gnat_ugn/gnat_utility_programs.rst: Document missing diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index 13d45ff..4f13d9c 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -963,10 +963,8 @@ package body Exp_Dist is when N_Package_Declaration => -- Case of a nested package or package instantiation coming - -- from source. Note that the anonymous wrapper package for - -- subprogram instances is not flagged Is_Generic_Instance at - -- this point, so there is a distinct circuit to handle them - -- (see case N_Subprogram_Instantiation below). + -- from source, including the wrapper package for an instance + -- of a generic subprogram. declare Pkg_Ent : constant Entity_Id := @@ -982,16 +980,6 @@ package body Exp_Dist is end if; end; - when N_Subprogram_Instantiation => - - -- The subprogram declaration for an instance of a generic - -- subprogram is wrapped in a package that does not come from - -- source, so we need to explicitly traverse it here. - - if Comes_From_Source (Decl) then - Visit_Nested_Pkg (Instance_Spec (Decl)); - end if; - when others => null; end case; -- cgit v1.1 From dafa2ae46c9f0d95821fd365e8c554008b934819 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Mon, 19 Aug 2019 08:36:12 +0000 Subject: [Ada] Factor out the "size for& too small..." error message Use a constant for the Size_Too_Small_Message, so if it changes, it won't change in one place but not another. DRY. It might be better to move this code out of errout.adb, but that's for another day. 2019-08-19 Bob Duff gcc/ada/ * errout.ads (Size_Too_Small_Message): New constant. * errout.adb, freeze.adb, sem_ch13.adb: Use it. From-SVN: r274648 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/errout.adb | 2 +- gcc/ada/errout.ads | 6 ++++++ gcc/ada/freeze.adb | 4 +--- gcc/ada/sem_ch13.adb | 2 +- 5 files changed, 14 insertions(+), 5 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e1342f4..c01d358 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-19 Bob Duff + + * errout.ads (Size_Too_Small_Message): New constant. + * errout.adb, freeze.adb, sem_ch13.adb: Use it. + 2019-08-19 Eric Botcazou * exp_dist.adb (Build_Package_Stubs): Do not specifically visit diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index ea524f3..f5a4925 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -3259,7 +3259,7 @@ package body Errout is -- Processing for "Size too small" messages - elsif Msg = "size for& too small, minimum allowed is ^" then + elsif Msg = Size_Too_Small_Message then -- Suppress "size too small" errors in CodePeer mode, since code may -- be analyzed in a different configuration than the one used for diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 10a43b1..9a54c7c 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -948,4 +948,10 @@ package Errout is -- This name is the identifier name as passed, cased according to the -- default identifier casing for the given file. + Size_Too_Small_Message : constant String := + "size for& too small, minimum allowed is ^"; + -- This message is explicitly tested in Special_Msg_Delete in the package + -- body, which is somewhat questionable, but at least by using a constant + -- we are obeying the DRY principle. + end Errout; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 78d1ed4..70f4b9d 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -786,9 +786,7 @@ package body Freeze is elsif Has_Size_Clause (T) then if RM_Size (T) < S then Error_Msg_Uint_1 := S; - Error_Msg_NE - ("size for& too small, minimum allowed is ^", - Size_Clause (T), T); + Error_Msg_NE (Size_Too_Small_Message, Size_Clause (T), T); end if; -- Set size if not set already diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 35a295c..92e308a 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -10835,7 +10835,7 @@ package body Sem_Ch13 is if not ASIS_Mode then Error_Msg_Uint_1 := Min_Siz; - Error_Msg_NE ("size for& too small, minimum allowed is ^", N, T); + Error_Msg_NE (Size_Too_Small_Message, N, T); end if; end Size_Too_Small_Error; -- cgit v1.1 From 4527ea2ed93d705b05a01a63561839748655505c Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 19 Aug 2019 08:36:17 +0000 Subject: [Ada] Improve placement of warning on formals of generic subprograms This patch modifies the handling of warnings on unused formal parameters of generic subprograms. Previously such warnings were placed on the formal appearing in the subprogram declaration, in contrast with warnings on non-generic subprograms, where the warning is placed on the corresponding entity in the body of the subprogram. This patch makes the handling of both cases uniform. It is preferable to place the warning in the body because this also provides a better suggestion for the placement of an Unreferenced pragma to suppress the warning when desired. 2019-08-19 Ed Schonberg gcc/ada/ * sem_warn.adb (Check_References, Generic_Body_Formal): When a formal parameter of a generic subprogram is not referenced in the body, place the corresponding warning on the corresponding entity in the specification of the generic body, as is done for non-generic subprograms. gcc/testsuite/ * gnat.dg/warn28.adb, gnat.dg/warn28.ads: New testcase. From-SVN: r274649 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/sem_warn.adb | 47 ++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 54 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c01d358..64f3cbb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-08-19 Ed Schonberg + + * sem_warn.adb (Check_References, Generic_Body_Formal): When a + formal parameter of a generic subprogram is not referenced in + the body, place the corresponding warning on the corresponding + entity in the specification of the generic body, as is done for + non-generic subprograms. + 2019-08-19 Bob Duff * errout.ads (Size_Too_Small_Message): New constant. diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index ab85162..ca6515c 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -818,6 +818,14 @@ package body Sem_Warn is -- For an entry formal entity from an entry declaration, find the -- corresponding body formal from the given accept statement. + function Generic_Body_Formal (E : Entity_Id) return Entity_Id; + -- Warnings on unused formals of subprograms are placed on the entity + -- in the subprogram body, which seems preferable because it suggests + -- a better codefix for GPS. The analysis of generic subprogram bodies + -- uses a different circuitry, so the choice for the proper placement + -- of the warning in the generic case takes place here, by finding the + -- body entity that corresponds to a formal in a spec. + procedure May_Need_Initialized_Actual (Ent : Entity_Id); -- If an entity of a generic type has default initialization, then the -- corresponding actual type should be fully initialized, or else there @@ -876,6 +884,35 @@ package body Sem_Warn is raise Program_Error; end Body_Formal; + ------------------------- + -- Generic_Body_Formal -- + ------------------------- + + function Generic_Body_Formal (E : Entity_Id) return Entity_Id is + Gen_Decl : constant Node_Id := Unit_Declaration_Node (Scope (E)); + Gen_Body : constant Entity_Id := Corresponding_Body (Gen_Decl); + Form : Entity_Id; + + begin + if No (Gen_Body) then + return E; + + else + Form := First_Entity (Gen_Body); + while Present (Form) loop + if Chars (Form) = Chars (E) then + return Form; + end if; + + Next_Entity (Form); + end loop; + end if; + + -- Should never fall through, should always find a match + + raise Program_Error; + end Generic_Body_Formal; + --------------------------------- -- May_Need_Initialized_Actual -- --------------------------------- @@ -1688,7 +1725,15 @@ package body Sem_Warn is elsif not Warnings_Off_E1 and then not Has_Junk_Name (E1) then - Unreferenced_Entities.Append (E1); + if Is_Formal (E1) + and then Nkind (Unit_Declaration_Node (Scope (E1))) + = N_Generic_Subprogram_Declaration + then + Unreferenced_Entities.Append + (Generic_Body_Formal (E1)); + else + Unreferenced_Entities.Append (E1); + end if; end if; end if; -- cgit v1.1 From 1f5c7ba85856618c1f14d4f581966baadbe02ddd Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 19 Aug 2019 08:36:21 +0000 Subject: [Ada] Fix incorrect stub generation for types in instances This fixes a fallout of a recent change clearing the Is_Generic_Actual_Type on the implicit full view of a private actual type in an instance. This flag is used to help disambiguating formal types instantiated on the same actual type within an instance, but it should be cleared outside the instance to let the usual disambiguation rules apply again to these types outside the instance. This in particular means that Exp_Dist cannot rely on it to detect subtypes representing generic actual types, hence the need for the new predicate. 2019-08-19 Eric Botcazou gcc/ada/ * exp_dist.adb (Is_Generic_Actual_Subtype): New predicate. (Build_From_Any_Call, Build_To_Any_Call, Build_TypeCode_Call): Use it instead of Is_Generic_Actual_Type flag to detect subtypes representing generic actual types. From-SVN: r274650 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/exp_dist.adb | 36 +++++++++++++++++++++++++++++++++--- 2 files changed, 40 insertions(+), 3 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 64f3cbb..5d48b3d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-08-19 Eric Botcazou + + * exp_dist.adb (Is_Generic_Actual_Subtype): New predicate. + (Build_From_Any_Call, Build_To_Any_Call, Build_TypeCode_Call): + Use it instead of Is_Generic_Actual_Type flag to detect subtypes + representing generic actual types. + 2019-08-19 Ed Schonberg * sem_warn.adb (Check_References, Generic_Body_Formal): When a diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index 4f13d9c..89218c4 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -8201,6 +8201,12 @@ package body Exp_Dist is -- type from Interfaces, or the smallest floating point type from -- Standard whose range encompasses that of Typ. + function Is_Generic_Actual_Subtype (Typ : Entity_Id) return Boolean; + -- Return true if Typ is a subtype representing a generic formal type + -- as a subtype of the actual type in an instance. This is needed to + -- recognize these subtypes because the Is_Generic_Actual_Type flag + -- can only be relied upon within the instance. + function Make_Helper_Function_Name (Loc : Source_Ptr; Typ : Entity_Id; @@ -8453,7 +8459,7 @@ package body Exp_Dist is -- For the subtype representing a generic actual type, go to the -- actual type. - if Is_Generic_Actual_Type (U_Type) then + if Is_Generic_Actual_Subtype (U_Type) then U_Type := Underlying_Type (Base_Type (U_Type)); end if; @@ -9262,7 +9268,7 @@ package body Exp_Dist is -- For the subtype representing a generic actual type, go to the -- actual type. - if Is_Generic_Actual_Type (U_Type) then + if Is_Generic_Actual_Subtype (U_Type) then U_Type := Underlying_Type (Base_Type (U_Type)); end if; @@ -10116,7 +10122,7 @@ package body Exp_Dist is -- For the subtype representing a generic actual type, go to the -- actual type. - if Is_Generic_Actual_Type (U_Type) then + if Is_Generic_Actual_Subtype (U_Type) then U_Type := Underlying_Type (Base_Type (U_Type)); end if; @@ -10901,6 +10907,30 @@ package body Exp_Dist is end Find_Numeric_Representation; + --------------------------------- + -- Is_Generic_Actual_Subtype -- + --------------------------------- + + function Is_Generic_Actual_Subtype (Typ : Entity_Id) return Boolean is + begin + if Is_Itype (Typ) + and then Present (Associated_Node_For_Itype (Typ)) + then + declare + N : constant Node_Id := Associated_Node_For_Itype (Typ); + begin + if Nkind (N) = N_Subtype_Declaration + and then Nkind (Parent (N)) = N_Package_Specification + and then Is_Generic_Instance (Scope_Of_Spec (Parent (N))) + then + return True; + end if; + end; + end if; + + return False; + end Is_Generic_Actual_Subtype; + --------------------------- -- Append_Array_Traversal -- --------------------------- -- cgit v1.1 From 593e0eba77594774db054cd98b879fbe1ffa29cc Mon Sep 17 00:00:00 2001 From: Patrick Bernardi Date: Mon, 19 Aug 2019 08:36:26 +0000 Subject: [Ada] Enable use of GNAT.Sockets for VxWorks RTP The recent introduction of GNAT.Sockets IPv6 support broke support for VxWorks RTPs due to the use of internal VxWorks kernel calls. This patch rectifies this by using the VxWorks public API for these routines. The following RTP should compile successfully on a Development profile VxWorks kernel that includes the INCLUDE_GETNAMEINFO component: with GNAT.Sockets; use GNAT.Sockets; procedure IPvX is procedure Print_Address_Info (Host, Serv : String; Family : Family_Type := Family_Unspec) is Addresses : Address_Info_Array := Get_Address_Info (Host, Serv, Family, Passive => False, Numeric_Host => False); begin Sort (Addresses, IPv6_TCP_Preferred'Access); end Print_Address_Info; begin Print_Address_Info ("localhost", "ssh"); end IPvX; 2019-08-19 Patrick Bernardi gcc/ada/ * socket.c: Removed the redefinition of getaddrinfo, getnameinfo and freeaddrinfo to internal VxWorks kernel calls because they are, well, internal kernel calls and cannot be called from RTPs. VxWorks provides the necessary components to call these routines directly. From-SVN: r274651 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/socket.c | 6 ------ 2 files changed, 8 insertions(+), 6 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5d48b3d..f89468e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-08-19 Patrick Bernardi + + * socket.c: Removed the redefinition of getaddrinfo, getnameinfo + and freeaddrinfo to internal VxWorks kernel calls because they + are, well, internal kernel calls and cannot be called from RTPs. + VxWorks provides the necessary components to call these routines + directly. + 2019-08-19 Eric Botcazou * exp_dist.adb (Is_Generic_Actual_Subtype): New predicate. diff --git a/gcc/ada/socket.c b/gcc/ada/socket.c index 8fc8415..94538d4 100644 --- a/gcc/ada/socket.c +++ b/gcc/ada/socket.c @@ -704,12 +704,6 @@ __gnat_servent_s_proto (struct servent * s) #if defined(AF_INET6) && !defined(__rtems__) -#if defined (__vxworks) -#define getaddrinfo ipcom_getaddrinfo -#define getnameinfo ipcom_getnameinfo -#define freeaddrinfo ipcom_freeaddrinfo -#endif - int __gnat_getaddrinfo( const char *node, const char *service, -- cgit v1.1 From eb6b9c9bcb5ac89eab098d3774e6429b6cfaeb6e Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Mon, 19 Aug 2019 08:36:30 +0000 Subject: [Ada] Improve warnings about "too few elements" and "too many elements" When warning about length-check failures detected at compile time that are flagged with "too few elements" or "too many elements", the compiler now gives an additional message indicating the number of elements expected by the context versus how many are present in the conflicting expression (such as an aggregate that has too few or too many components). The test below reports the following warnings when compiled with this command: $ gcc -c -gnatj78 length_warnings.adb length_warnings.adb:6:09: warning: too few elements for subtype of "Boolean_Array" defined at line 5, expected 10 elements; found 9 elements, "Constraint_Error" will be raised at run time length_warnings.adb:10:09: warning: too few elements for subtype of "Boolean_Array" defined at line 9, expected 2 elements; found 1 element, "Constraint_Error" will be raised at run time length_warnings.adb:14:09: warning: too many elements for subtype of "Boolean_Array" defined at line 13, expected 10 elements; found 11 elements, "Constraint_Error" will be raised at run time length_warnings.adb:18:09: warning: too many elements for subtype of "Boolean_Array" defined at line 17, expected 0 elements; found 1 element, "Constraint_Error" will be raised at run time length_warnings.adb:22:09: warning: too many elements for subtype of "Boolean_Array" defined at line 21, expected 1 element; found 2 elements, "Constraint_Error" will be raised at run time procedure Length_Check_Warnings is type Boolean_Array is array (Natural range <>) of Boolean; Bits_A : Boolean_Array (1 .. 10) := (True, True, True, True, True, True, True, True, True); -- Too few elements Bits_B : Boolean_Array (1 .. 2) := (1 => False); -- Too few elements Bits_C : Boolean_Array (1 .. 10) := (True, True, True, True, True, True, True, True, True, True, True); -- Too many elements Bits_D : Boolean_Array (1 .. 0) := (1 => True); -- Too many elements Bits_E : Boolean_Array (1 .. 1) := (True, False); -- Too many elements begin null; end Length_Check_Warnings; 2019-08-19 Gary Dismukes gcc/ada/ * checks.adb (Length_Mismatch_Info_Message): New function in Selected_Length_Checks to return a message indicating the element counts for the mismatched lengths for a failed compile-time length check. (Plural_Or_Singular_Ending): Support function in Length_Mismatch_Info_Message to return either "" or "s", for concatenating to the end of words. (Selected_Length_Checks): Pass the result of Length_Mismatch_Info_Message as an extra warning message to Compile_Time_Constraint_Error to indicate the mismatched lengths for a failed compile-time length check. * sem_util.ads (Compile_Time_Constraint_Error): Add an optional message formal (Extra_Msg), defaulted to the empty string. * sem_util.adb (Compile_Time_Constraint_Error): Output an extra message following the main warning message (when Extra_Msg is not the empty string). From-SVN: r274652 --- gcc/ada/ChangeLog | 19 +++++++++++++++++++ gcc/ada/checks.adb | 44 ++++++++++++++++++++++++++++++++++++++++++-- gcc/ada/sem_util.adb | 17 ++++++++++++----- gcc/ada/sem_util.ads | 14 +++++++++----- 4 files changed, 82 insertions(+), 12 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f89468e..6f31df1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2019-08-19 Gary Dismukes + + * checks.adb (Length_Mismatch_Info_Message): New function in + Selected_Length_Checks to return a message indicating the + element counts for the mismatched lengths for a failed + compile-time length check. + (Plural_Or_Singular_Ending): Support function in + Length_Mismatch_Info_Message to return either "" or "s", for + concatenating to the end of words. + (Selected_Length_Checks): Pass the result of + Length_Mismatch_Info_Message as an extra warning message to + Compile_Time_Constraint_Error to indicate the mismatched lengths + for a failed compile-time length check. + * sem_util.ads (Compile_Time_Constraint_Error): Add an optional + message formal (Extra_Msg), defaulted to the empty string. + * sem_util.adb (Compile_Time_Constraint_Error): Output an extra + message following the main warning message (when Extra_Msg is + not the empty string). + 2019-08-19 Patrick Bernardi * socket.c: Removed the redefinition of getaddrinfo, getnameinfo diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 470ea3f..03cfcef 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -9542,6 +9542,12 @@ package body Checks is -- Returns expression to compute: -- Typ'Length /= Expr'Length + function Length_Mismatch_Info_Message + (Left_Element_Count : Uint; + Right_Element_Count : Uint) return String; + -- Returns a message indicating how many elements were expected + -- (Left_Element_Count) and how many were found (Right_Element_Count). + --------------- -- Add_Check -- --------------- @@ -9729,6 +9735,36 @@ package body Checks is Right_Opnd => Get_N_Length (Expr, Indx)); end Length_N_Cond; + ---------------------------------- + -- Length_Mismatch_Info_Message -- + ---------------------------------- + + function Length_Mismatch_Info_Message + (Left_Element_Count : Uint; + Right_Element_Count : Uint) return String + is + + function Plural_Vs_Singular_Ending (Count : Uint) return String; + -- Returns an empty string if Count is 1; otherwise returns "s" + + function Plural_Vs_Singular_Ending (Count : Uint) return String is + begin + if Count = 1 then + return ""; + else + return "s"; + end if; + end Plural_Vs_Singular_Ending; + + begin + return "expected " & UI_Image (Left_Element_Count) + & " element" + & Plural_Vs_Singular_Ending (Left_Element_Count) + & "; found " & UI_Image (Right_Element_Count) + & " element" + & Plural_Vs_Singular_Ending (Right_Element_Count); + end Length_Mismatch_Info_Message; + ----------------- -- Same_Bounds -- ----------------- @@ -9923,12 +9959,16 @@ package body Checks is if L_Length > R_Length then Add_Check (Compile_Time_Constraint_Error - (Wnode, "too few elements for}??", T_Typ)); + (Wnode, "too few elements for}??", T_Typ, + Extra_Msg => Length_Mismatch_Info_Message + (L_Length, R_Length))); elsif L_Length < R_Length then Add_Check (Compile_Time_Constraint_Error - (Wnode, "too many elements for}??", T_Typ)); + (Wnode, "too many elements for}??", T_Typ, + Extra_Msg => Length_Mismatch_Info_Message + (L_Length, R_Length))); end if; -- The comparison for an individual index subtype diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 10f8ffb..dcef852 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -5358,11 +5358,12 @@ package body Sem_Util is ----------------------------------- function Compile_Time_Constraint_Error - (N : Node_Id; - Msg : String; - Ent : Entity_Id := Empty; - Loc : Source_Ptr := No_Location; - Warn : Boolean := False) return Node_Id + (N : Node_Id; + Msg : String; + Ent : Entity_Id := Empty; + Loc : Source_Ptr := No_Location; + Warn : Boolean := False; + Extra_Msg : String := "") return Node_Id is Msgc : String (1 .. Msg'Length + 3); -- Copy of message, with room for possible ?? or << and ! at end @@ -5456,6 +5457,12 @@ package body Sem_Util is Error_Msg_NEL (Msgc (1 .. Msgl), N, Etype (N), Eloc); end if; + -- Emit any extra message as a continuation + + if Extra_Msg /= "" then + Error_Msg_N ('\' & Extra_Msg, N); + end if; + if Wmsg then -- Check whether the context is an Init_Proc diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 1d3fcbf..4d738da 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -465,16 +465,20 @@ package Sem_Util is -- the type itself. function Compile_Time_Constraint_Error - (N : Node_Id; - Msg : String; - Ent : Entity_Id := Empty; - Loc : Source_Ptr := No_Location; - Warn : Boolean := False) return Node_Id; + (N : Node_Id; + Msg : String; + Ent : Entity_Id := Empty; + Loc : Source_Ptr := No_Location; + Warn : Boolean := False; + Extra_Msg : String := "") return Node_Id; -- This is similar to Apply_Compile_Time_Constraint_Error in that it -- generates a warning (or error) message in the same manner, but it does -- not replace any nodes. For convenience, the function always returns its -- first argument. The message is a warning if the message ends with ?, or -- we are operating in Ada 83 mode, or the Warn parameter is set to True. + -- If Extra_Msg is not a null string, then it's associated with N and + -- emitted immediately after the main message (and before output of any + -- message indicating that Constraint_Error will be raised). procedure Conditional_Delay (New_Ent, Old_Ent : Entity_Id); -- Sets the Has_Delayed_Freeze flag of New_Ent if the Delayed_Freeze flag -- cgit v1.1 From d403cfad2f90edf5fd8d8f6040177487ae9e167a Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Mon, 19 Aug 2019 08:36:35 +0000 Subject: [Ada] Process type extensions for -gnatw.h This patch enables gap detection in type extensions. With the -gnatw.h switch, on 64-bit machines, the following test should get warnings: gcc -c gaps.ads -gnatw.h gaps.ads:16:07: warning: 48-bit gap before component "Comp2" gaps.ads:17:07: warning: 8-bit gap before component "Comp3" package Gaps is type Integer_16 is mod 2**16; type TestGap is tagged record Comp1 : Integer_16; end record; for TestGap use record Comp1 at 0 + 8 range 0..15; end record; type TestGap2 is new TestGap with record Comp2 : Integer_16; Comp3 : Integer_16; end record; for TestGap2 use record Comp2 at 08 + 8 range 0..15; Comp3 at 11 + 8 range 0..15; end record; end Gaps; 2019-08-19 Bob Duff gcc/ada/ * sem_ch13.adb (Record_Hole_Check): Procedure to check for holes that incudes processing type extensions. A type extension is processed by first calling Record_Hole_Check recursively on the parent type to compute the bit number after the last component of the parent. From-SVN: r274653 --- gcc/ada/ChangeLog | 8 + gcc/ada/sem_ch13.adb | 419 +++++++++++++++++++++++++++++---------------------- 2 files changed, 243 insertions(+), 184 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6f31df1..f6e0085 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-08-19 Bob Duff + + * sem_ch13.adb (Record_Hole_Check): Procedure to check for holes + that incudes processing type extensions. A type extension is + processed by first calling Record_Hole_Check recursively on the + parent type to compute the bit number after the last component + of the parent. + 2019-08-19 Gary Dismukes * checks.adb (Length_Mismatch_Info_Message): New function in diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 92e308a..a3a7be7 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -10122,6 +10122,14 @@ package body Sem_Ch13 is -- issued, since the message was already given. Comp is also set to -- Empty if the current "component clause" is in fact a pragma. + procedure Record_Hole_Check + (Rectype : Entity_Id; After_Last : out Uint; Warn : Boolean); + -- Checks for gaps in the given Rectype. Compute After_Last, the bit + -- number after the last component. Warn is True on the initial call, + -- and warnings are given for gaps. For a type extension, this is called + -- recursively to compute After_Last for the parent type; in this case + -- Warn is False and the warnings are suppressed. + ----------------------------- -- Check_Component_Overlap -- ----------------------------- @@ -10233,6 +10241,225 @@ package body Sem_Ch13 is end if; end Find_Component; + ----------------------- + -- Record_Hole_Check -- + ----------------------- + + procedure Record_Hole_Check + (Rectype : Entity_Id; After_Last : out Uint; Warn : Boolean) + is + Decl : constant Node_Id := Declaration_Node (Base_Type (Rectype)); + -- Full declaration of record type + + procedure Check_Component_List + (DS : List_Id; + CL : Node_Id; + Sbit : Uint; + Abit : out Uint); + -- Check component list CL for holes. DS is a list of discriminant + -- specifications to be included in the consideration of components. + -- Sbit is the starting bit, which is zero if there are no preceding + -- components (before a variant part, or a parent type, or a tag + -- field). If there are preceding components, Sbit is the bit just + -- after the last such component. Abit is set to the bit just after + -- the last component of DS and CL. + + -------------------------- + -- Check_Component_List -- + -------------------------- + + procedure Check_Component_List + (DS : List_Id; + CL : Node_Id; + Sbit : Uint; + Abit : out Uint) + is + Compl : Integer; + + begin + Compl := Integer (List_Length (Component_Items (CL))); + + if DS /= No_List then + Compl := Compl + Integer (List_Length (DS)); + end if; + + declare + Comps : array (Natural range 0 .. Compl) of Entity_Id; + -- Gather components (zero entry is for sort routine) + + Ncomps : Natural := 0; + -- Number of entries stored in Comps (starting at Comps (1)) + + Citem : Node_Id; + -- One component item or discriminant specification + + Nbit : Uint; + -- Starting bit for next component + + CEnt : Entity_Id; + -- Component entity + + Variant : Node_Id; + -- One variant + + function Lt (Op1, Op2 : Natural) return Boolean; + -- Compare routine for Sort + + procedure Move (From : Natural; To : Natural); + -- Move routine for Sort + + package Sorting is new GNAT.Heap_Sort_G (Move, Lt); + + -------- + -- Lt -- + -------- + + function Lt (Op1, Op2 : Natural) return Boolean is + begin + return Component_Bit_Offset (Comps (Op1)) + < Component_Bit_Offset (Comps (Op2)); + end Lt; + + ---------- + -- Move -- + ---------- + + procedure Move (From : Natural; To : Natural) is + begin + Comps (To) := Comps (From); + end Move; + + begin + -- Gather discriminants into Comp + + if DS /= No_List then + Citem := First (DS); + while Present (Citem) loop + if Nkind (Citem) = N_Discriminant_Specification then + declare + Ent : constant Entity_Id := + Defining_Identifier (Citem); + begin + if Ekind (Ent) = E_Discriminant then + Ncomps := Ncomps + 1; + Comps (Ncomps) := Ent; + end if; + end; + end if; + + Next (Citem); + end loop; + end if; + + -- Gather component entities into Comp + + Citem := First (Component_Items (CL)); + while Present (Citem) loop + if Nkind (Citem) = N_Component_Declaration then + Ncomps := Ncomps + 1; + Comps (Ncomps) := Defining_Identifier (Citem); + end if; + + Next (Citem); + end loop; + + -- Now sort the component entities based on the first bit. + -- Note we already know there are no overlapping components. + + Sorting.Sort (Ncomps); + + -- Loop through entries checking for holes + + Nbit := Sbit; + for J in 1 .. Ncomps loop + CEnt := Comps (J); + + declare + CBO : constant Uint := Component_Bit_Offset (CEnt); + + begin + -- Skip components with unknown offsets + + if CBO /= No_Uint and then CBO >= 0 then + Error_Msg_Uint_1 := CBO - Nbit; + + if Warn and then Error_Msg_Uint_1 > 0 then + Error_Msg_NE + ("?H?^-bit gap before component&", + Component_Name (Component_Clause (CEnt)), + CEnt); + end if; + + Nbit := CBO + Esize (CEnt); + end if; + end; + end loop; + + -- Set Abit to just after the last nonvariant component + + Abit := Nbit; + + -- Process variant parts recursively if present. Set Abit to + -- the maximum for all variant parts. + + if Present (Variant_Part (CL)) then + declare + Var_Start : constant Uint := Nbit; + begin + Variant := First (Variants (Variant_Part (CL))); + while Present (Variant) loop + Check_Component_List + (No_List, Component_List (Variant), Var_Start, Nbit); + Next (Variant); + if Nbit > Abit then + Abit := Nbit; + end if; + end loop; + end; + end if; + end; + end Check_Component_List; + + Sbit : Uint; + -- Starting bit for call to Check_Component_List. Zero for an + -- untagged type. The size of the Tag for a nonderived tagged + -- type. Parent size for a type extension. + + Record_Definition : Node_Id; + -- Record_Definition containing Component_List to pass to + -- Check_Component_List. + + -- Start of processing for Record_Hole_Check + + begin + if Is_Tagged_Type (Rectype) then + Sbit := UI_From_Int (System_Address_Size); + else + Sbit := Uint_0; + end if; + + if Nkind (Decl) = N_Full_Type_Declaration then + Record_Definition := Type_Definition (Decl); + + -- If we have a record extension, set Sbit to point after the last + -- component of the parent type, by calling Record_Hole_Check + -- recursively. + + if Nkind (Record_Definition) = N_Derived_Type_Definition then + Record_Definition := Record_Extension_Part (Record_Definition); + Record_Hole_Check (Underlying_Type (Parent_Subtype (Rectype)), + After_Last => Sbit, Warn => False); + end if; + + if Nkind (Record_Definition) = N_Record_Definition then + Check_Component_List + (Discriminant_Specifications (Decl), + Component_List (Record_Definition), + Sbit, After_Last); + end if; + end if; + end Record_Hole_Check; + -- Start of processing for Check_Record_Representation_Clause begin @@ -10589,192 +10816,16 @@ package body Sem_Ch13 is end Overlap_Check2; end if; - -- The following circuit deals with warning on record holes (gaps). We - -- skip this check if overlap was detected, since it makes sense for the - -- programmer to fix this illegality before worrying about warnings. - - if not Overlap_Detected and Warn_On_Record_Holes then - Record_Hole_Check : declare - Decl : constant Node_Id := Declaration_Node (Base_Type (Rectype)); - -- Full declaration of record type - - procedure Check_Component_List - (CL : Node_Id; - Sbit : Uint; - DS : List_Id); - -- Check component list CL for holes. The starting bit should be - -- Sbit. which is zero for the main record component list and set - -- appropriately for recursive calls for variants. DS is set to - -- a list of discriminant specifications to be included in the - -- consideration of components. It is No_List if none to consider. - - -------------------------- - -- Check_Component_List -- - -------------------------- - - procedure Check_Component_List - (CL : Node_Id; - Sbit : Uint; - DS : List_Id) - is - Compl : Integer; - - begin - Compl := Integer (List_Length (Component_Items (CL))); - - if DS /= No_List then - Compl := Compl + Integer (List_Length (DS)); - end if; - - declare - Comps : array (Natural range 0 .. Compl) of Entity_Id; - -- Gather components (zero entry is for sort routine) - - Ncomps : Natural := 0; - -- Number of entries stored in Comps (starting at Comps (1)) - - Citem : Node_Id; - -- One component item or discriminant specification - - Nbit : Uint; - -- Starting bit for next component - - CEnt : Entity_Id; - -- Component entity - - Variant : Node_Id; - -- One variant - - function Lt (Op1, Op2 : Natural) return Boolean; - -- Compare routine for Sort - - procedure Move (From : Natural; To : Natural); - -- Move routine for Sort - - package Sorting is new GNAT.Heap_Sort_G (Move, Lt); - - -------- - -- Lt -- - -------- - - function Lt (Op1, Op2 : Natural) return Boolean is - begin - return Component_Bit_Offset (Comps (Op1)) - < - Component_Bit_Offset (Comps (Op2)); - end Lt; - - ---------- - -- Move -- - ---------- - - procedure Move (From : Natural; To : Natural) is - begin - Comps (To) := Comps (From); - end Move; - - begin - -- Gather discriminants into Comp - - if DS /= No_List then - Citem := First (DS); - while Present (Citem) loop - if Nkind (Citem) = N_Discriminant_Specification then - declare - Ent : constant Entity_Id := - Defining_Identifier (Citem); - begin - if Ekind (Ent) = E_Discriminant then - Ncomps := Ncomps + 1; - Comps (Ncomps) := Ent; - end if; - end; - end if; - - Next (Citem); - end loop; - end if; - - -- Gather component entities into Comp - - Citem := First (Component_Items (CL)); - while Present (Citem) loop - if Nkind (Citem) = N_Component_Declaration then - Ncomps := Ncomps + 1; - Comps (Ncomps) := Defining_Identifier (Citem); - end if; - - Next (Citem); - end loop; - - -- Now sort the component entities based on the first bit. - -- Note we already know there are no overlapping components. - - Sorting.Sort (Ncomps); - - -- Loop through entries checking for holes - - Nbit := Sbit; - for J in 1 .. Ncomps loop - CEnt := Comps (J); - - declare - CBO : constant Uint := Component_Bit_Offset (CEnt); - - begin - -- Skip components with unknown offsets - - if CBO /= No_Uint and then CBO >= 0 then - Error_Msg_Uint_1 := CBO - Nbit; - - if Error_Msg_Uint_1 > 0 then - Error_Msg_NE - ("?H?^-bit gap before component&", - Component_Name (Component_Clause (CEnt)), - CEnt); - end if; - - Nbit := CBO + Esize (CEnt); - end if; - end; - end loop; - - -- Process variant parts recursively if present - - if Present (Variant_Part (CL)) then - Variant := First (Variants (Variant_Part (CL))); - while Present (Variant) loop - Check_Component_List - (Component_List (Variant), Nbit, No_List); - Next (Variant); - end loop; - end if; - end; - end Check_Component_List; - - -- Start of processing for Record_Hole_Check + -- Check for record holes (gaps). We skip this check if overlap was + -- detected, since it makes sense for the programmer to fix this + -- error before worrying about warnings. + if Warn_On_Record_Holes and not Overlap_Detected then + declare + Ignore : Uint; begin - declare - Sbit : Uint; - - begin - if Is_Tagged_Type (Rectype) then - Sbit := UI_From_Int (System_Address_Size); - else - Sbit := Uint_0; - end if; - - if Nkind (Decl) = N_Full_Type_Declaration - and then Nkind (Type_Definition (Decl)) = N_Record_Definition - then - Check_Component_List - (Component_List (Type_Definition (Decl)), - Sbit, - Discriminant_Specifications (Decl)); - end if; - end; - end Record_Hole_Check; + Record_Hole_Check (Rectype, After_Last => Ignore, Warn => True); + end; end if; -- For records that have component clauses for all components, and whose -- cgit v1.1 From bd5ed03ae9217ae903131e7345cf4ef7e6ba3437 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Mon, 19 Aug 2019 08:36:39 +0000 Subject: [Ada] Buffer reading overflow in dispatch table initialization For tagged types not defined at library level that derive from library level tagged types the compiler may generate code to initialize their dispatch table of predefined primitives copying from the parent type data stored in memory after the dispatch table of the parent; that is, at runtime the initialization of dispatch tables overflows reading the parent dispatch table. This problem does not affect the execution of the program since the target dispatch table always has enough space to store the extra data, and after such copy the compiler generates code to complete the initialization of the dispatch table. The following test must compile and execute without errors. package pkg_a is type Root is tagged null record; end pkg_a; with pkg_a; procedure main is type Derived is new pkg_a.Root with null record; -- Test begin null; end main; Command: gnatmake -q main -fsanitize=address; ./main 2019-08-19 Javier Miranda gcc/ada/ PR ada/65696 * exp_atag.ads, exp_atag.adb (Build_Inherit_Predefined_Prims): Adding formal to specify how many predefined primitives are inherited from the parent type. * exp_disp.adb (Number_Of_Predefined_Prims): New subprogram. (Make_Secondary_DT): Compute the number of predefined primitives of all tagged types (including tagged types not defined at library level). Previously we unconditionally relied on the Max_Predef_Prims constant value when building the dispatch tables of tagged types not defined at library level (thus consuming more memory for their dispatch tables than required). (Make_DT): Compute the number of predefined primitives that must be inherited from their parent type when building the dispatch tables of tagged types not defined at library level. Previously we unconditionally relied on the Max_Predef_Prims constant value when building the dispatch tables of tagged types not defined at library level (thus copying more data than required from the parent type). From-SVN: r274654 --- gcc/ada/ChangeLog | 21 +++++ gcc/ada/exp_atag.adb | 11 +-- gcc/ada/exp_atag.ads | 7 +- gcc/ada/exp_disp.adb | 229 +++++++++++++++++++++++++-------------------------- 4 files changed, 142 insertions(+), 126 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f6e0085..f193063 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +2019-08-19 Javier Miranda + + PR ada/65696 + * exp_atag.ads, exp_atag.adb (Build_Inherit_Predefined_Prims): + Adding formal to specify how many predefined primitives are + inherited from the parent type. + * exp_disp.adb (Number_Of_Predefined_Prims): New subprogram. + (Make_Secondary_DT): Compute the number of predefined primitives + of all tagged types (including tagged types not defined at + library level). Previously we unconditionally relied on the + Max_Predef_Prims constant value when building the dispatch + tables of tagged types not defined at library level (thus + consuming more memory for their dispatch tables than required). + (Make_DT): Compute the number of predefined primitives that must + be inherited from their parent type when building the dispatch + tables of tagged types not defined at library level. Previously + we unconditionally relied on the Max_Predef_Prims constant value + when building the dispatch tables of tagged types not defined at + library level (thus copying more data than required from the + parent type). + 2019-08-19 Bob Duff * sem_ch13.adb (Record_Hole_Check): Procedure to check for holes diff --git a/gcc/ada/exp_atag.adb b/gcc/ada/exp_atag.adb index 567bb29..db1833c 100644 --- a/gcc/ada/exp_atag.adb +++ b/gcc/ada/exp_atag.adb @@ -742,9 +742,10 @@ package body Exp_Atag is ------------------------------------ function Build_Inherit_Predefined_Prims - (Loc : Source_Ptr; - Old_Tag_Node : Node_Id; - New_Tag_Node : Node_Id) return Node_Id + (Loc : Source_Ptr; + Old_Tag_Node : Node_Id; + New_Tag_Node : Node_Id; + Num_Predef_Prims : Int) return Node_Id is begin return @@ -759,7 +760,7 @@ package body Exp_Atag is New_Tag_Node)))), Discrete_Range => Make_Range (Loc, Make_Integer_Literal (Loc, Uint_1), - New_Occurrence_Of (RTE (RE_Max_Predef_Prims), Loc))), + Make_Integer_Literal (Loc, Num_Predef_Prims))), Expression => Make_Slice (Loc, @@ -772,7 +773,7 @@ package body Exp_Atag is Discrete_Range => Make_Range (Loc, Make_Integer_Literal (Loc, 1), - New_Occurrence_Of (RTE (RE_Max_Predef_Prims), Loc)))); + Make_Integer_Literal (Loc, Num_Predef_Prims)))); end Build_Inherit_Predefined_Prims; ------------------------- diff --git a/gcc/ada/exp_atag.ads b/gcc/ada/exp_atag.ads index d6a4dbb..e8d5e62 100644 --- a/gcc/ada/exp_atag.ads +++ b/gcc/ada/exp_atag.ads @@ -109,9 +109,10 @@ package Exp_Atag is -- generated code handles primary and secondary dispatch tables of Typ. function Build_Inherit_Predefined_Prims - (Loc : Source_Ptr; - Old_Tag_Node : Node_Id; - New_Tag_Node : Node_Id) return Node_Id; + (Loc : Source_Ptr; + Old_Tag_Node : Node_Id; + New_Tag_Node : Node_Id; + Num_Predef_Prims : Int) return Node_Id; -- Build code that inherits the predefined primitives of the parent. -- -- Generates: Predefined_DT (New_T).D (All_Predefined_Prims) := diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 8399c4c..35fc484 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -3817,6 +3817,9 @@ package body Exp_Disp is -- this secondary dispatch table by Make_Tags when its unique external -- name was generated. + function Number_Of_Predefined_Prims (Typ : Entity_Id) return Nat; + -- Returns the number of predefined primitives of Typ + ------------------------------ -- Check_Premature_Freezing -- ------------------------------ @@ -3970,12 +3973,10 @@ package body Exp_Disp is DT_Constr_List : List_Id; DT_Aggr_List : List_Id; Empty_DT : Boolean := False; - Nb_Predef_Prims : Nat := 0; Nb_Prim : Nat; New_Node : Node_Id; OSD : Entity_Id; OSD_Aggr_List : List_Id; - Pos : Nat; Prim : Entity_Id; Prim_Elmt : Elmt_Id; Prim_Ops_Aggr_List : List_Id; @@ -4022,38 +4023,12 @@ package body Exp_Disp is -- predef-prim-op-thunk-n'address); -- for Predef_Prims'Alignment use Address'Alignment - -- Stage 1: Calculate the number of predefined primitives - - if not Building_Static_DT (Typ) then - Nb_Predef_Prims := Max_Predef_Prims; - else - Prim_Elmt := First_Elmt (Primitive_Operations (Typ)); - while Present (Prim_Elmt) loop - Prim := Node (Prim_Elmt); - - if Is_Predefined_Dispatching_Operation (Prim) - and then not Is_Abstract_Subprogram (Prim) - then - Pos := UI_To_Int (DT_Position (Prim)); - - if Pos > Nb_Predef_Prims then - Nb_Predef_Prims := Pos; - end if; - end if; - - Next_Elmt (Prim_Elmt); - end loop; - end if; - - if Generate_SCIL then - Nb_Predef_Prims := 0; - end if; - - -- Stage 2: Create the thunks associated with the predefined - -- primitives and save their entity to fill the aggregate. + -- Create the thunks associated with the predefined primitives and + -- save their entity to fill the aggregate. declare - Prim_Table : array (Nat range 1 .. Nb_Predef_Prims) of Entity_Id; + Nb_P_Prims : constant Nat := Number_Of_Predefined_Prims (Typ); + Prim_Table : array (Nat range 1 .. Nb_P_Prims) of Entity_Id; Decl : Node_Id; Thunk_Id : Entity_Id; Thunk_Code : Node_Id; @@ -4525,6 +4500,44 @@ package body Exp_Disp is Append_Elmt (Iface_DT, DT_Decl); end Make_Secondary_DT; + -------------------------------- + -- Number_Of_Predefined_Prims -- + -------------------------------- + + function Number_Of_Predefined_Prims (Typ : Entity_Id) return Nat is + Nb_Predef_Prims : Nat := 0; + + begin + if not Generate_SCIL then + declare + Prim : Entity_Id; + Prim_Elmt : Elmt_Id; + Pos : Nat; + + begin + Prim_Elmt := First_Elmt (Primitive_Operations (Typ)); + while Present (Prim_Elmt) loop + Prim := Node (Prim_Elmt); + + if Is_Predefined_Dispatching_Operation (Prim) + and then not Is_Abstract_Subprogram (Prim) + then + Pos := UI_To_Int (DT_Position (Prim)); + + if Pos > Nb_Predef_Prims then + Nb_Predef_Prims := Pos; + end if; + end if; + + Next_Elmt (Prim_Elmt); + end loop; + end; + end if; + + pragma Assert (Nb_Predef_Prims <= Max_Predef_Prims); + return Nb_Predef_Prims; + end Number_Of_Predefined_Prims; + -- Local variables Elab_Code : constant List_Id := New_List; @@ -4584,7 +4597,6 @@ package body Exp_Disp is I_Depth : Nat := 0; Iface_Table_Node : Node_Id; Name_ITable : Name_Id; - Nb_Predef_Prims : Nat := 0; Nb_Prim : Nat := 0; New_Node : Node_Id; Num_Ifaces : Nat := 0; @@ -5924,112 +5936,85 @@ package body Exp_Disp is else declare - Pos : Nat; + Nb_P_Prims : constant Nat := Number_Of_Predefined_Prims (Typ); + Prim_Table : array (Nat range 1 .. Nb_P_Prims) of Entity_Id; + Decl : Node_Id; + E : Entity_Id; begin - if not Building_Static_DT (Typ) then - Nb_Predef_Prims := Max_Predef_Prims; + Prim_Ops_Aggr_List := New_List; + Prim_Table := (others => Empty); - else - Prim_Elmt := First_Elmt (Primitive_Operations (Typ)); + if Building_Static_DT (Typ) then + Prim_Elmt := First_Elmt (Primitive_Operations (Typ)); while Present (Prim_Elmt) loop Prim := Node (Prim_Elmt); if Is_Predefined_Dispatching_Operation (Prim) and then not Is_Abstract_Subprogram (Prim) + and then not Is_Eliminated (Prim) + and then not Generate_SCIL + and then not Present (Prim_Table + (UI_To_Int (DT_Position (Prim)))) then - Pos := UI_To_Int (DT_Position (Prim)); - - if Pos > Nb_Predef_Prims then - Nb_Predef_Prims := Pos; - end if; + E := Ultimate_Alias (Prim); + pragma Assert (not Is_Abstract_Subprogram (E)); + Prim_Table (UI_To_Int (DT_Position (Prim))) := E; end if; Next_Elmt (Prim_Elmt); end loop; end if; - declare - Prim_Table : array - (Nat range 1 .. Nb_Predef_Prims) of Entity_Id; - Decl : Node_Id; - E : Entity_Id; - - begin - Prim_Ops_Aggr_List := New_List; - - Prim_Table := (others => Empty); - - if Building_Static_DT (Typ) then - Prim_Elmt := First_Elmt (Primitive_Operations (Typ)); - while Present (Prim_Elmt) loop - Prim := Node (Prim_Elmt); - - if Is_Predefined_Dispatching_Operation (Prim) - and then not Is_Abstract_Subprogram (Prim) - and then not Is_Eliminated (Prim) - and then not Present (Prim_Table - (UI_To_Int (DT_Position (Prim)))) - then - E := Ultimate_Alias (Prim); - pragma Assert (not Is_Abstract_Subprogram (E)); - Prim_Table (UI_To_Int (DT_Position (Prim))) := E; - end if; - - Next_Elmt (Prim_Elmt); - end loop; + for J in Prim_Table'Range loop + if Present (Prim_Table (J)) then + New_Node := + Unchecked_Convert_To (RTE (RE_Prim_Ptr), + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of (Prim_Table (J), Loc), + Attribute_Name => Name_Unrestricted_Access)); + else + New_Node := Make_Null (Loc); end if; - for J in Prim_Table'Range loop - if Present (Prim_Table (J)) then - New_Node := - Unchecked_Convert_To (RTE (RE_Prim_Ptr), - Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Prim_Table (J), Loc), - Attribute_Name => Name_Unrestricted_Access)); - else - New_Node := Make_Null (Loc); - end if; - - Append_To (Prim_Ops_Aggr_List, New_Node); - end loop; + Append_To (Prim_Ops_Aggr_List, New_Node); + end loop; - New_Node := - Make_Aggregate (Loc, - Expressions => Prim_Ops_Aggr_List); + New_Node := + Make_Aggregate (Loc, + Expressions => Prim_Ops_Aggr_List); - Decl := - Make_Subtype_Declaration (Loc, - Defining_Identifier => Make_Temporary (Loc, 'S'), - Subtype_Indication => - New_Occurrence_Of (RTE (RE_Address_Array), Loc)); + Decl := + Make_Subtype_Declaration (Loc, + Defining_Identifier => Make_Temporary (Loc, 'S'), + Subtype_Indication => + New_Occurrence_Of (RTE (RE_Address_Array), Loc)); - Append_To (Result, Decl); + Append_To (Result, Decl); - Append_To (Result, - Make_Object_Declaration (Loc, - Defining_Identifier => Predef_Prims, - Aliased_Present => True, - Constant_Present => Building_Static_DT (Typ), - Object_Definition => - New_Occurrence_Of (Defining_Identifier (Decl), Loc), - Expression => New_Node)); + Append_To (Result, + Make_Object_Declaration (Loc, + Defining_Identifier => Predef_Prims, + Aliased_Present => True, + Constant_Present => Building_Static_DT (Typ), + Object_Definition => + New_Occurrence_Of (Defining_Identifier (Decl), Loc), + Expression => New_Node)); - -- Remember aggregates initializing dispatch tables + -- Remember aggregates initializing dispatch tables - Append_Elmt (New_Node, DT_Aggr); + Append_Elmt (New_Node, DT_Aggr); - Append_To (Result, - Make_Attribute_Definition_Clause (Loc, - Name => New_Occurrence_Of (Predef_Prims, Loc), - Chars => Name_Alignment, - Expression => - Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (RTE (RE_Integer_Address), Loc), - Attribute_Name => Name_Alignment))); - end; + Append_To (Result, + Make_Attribute_Definition_Clause (Loc, + Name => New_Occurrence_Of (Predef_Prims, Loc), + Chars => Name_Alignment, + Expression => + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of (RTE (RE_Integer_Address), Loc), + Attribute_Name => Name_Alignment))); end; -- Stage 1: Initialize the discriminant and the record components @@ -6301,7 +6286,9 @@ package body Exp_Disp is (Node (Next_Elmt (First_Elmt - (Access_Disp_Table (Typ)))), Loc))); + (Access_Disp_Table (Typ)))), Loc), + Num_Predef_Prims => + Number_Of_Predefined_Prims (Parent_Typ))); if Nb_Prims /= 0 then Append_To (Elab_Code, @@ -6390,7 +6377,10 @@ package body Exp_Disp is Unchecked_Convert_To (RTE (RE_Tag), New_Occurrence_Of (Node (Next_Elmt (Sec_DT_Typ)), - Loc)))); + Loc)), + Num_Predef_Prims => + Number_Of_Predefined_Prims + (Parent_Typ))); if Num_Prims /= 0 then Append_To (Elab_Code, @@ -6436,7 +6426,10 @@ package body Exp_Disp is Unchecked_Convert_To (RTE (RE_Tag), New_Occurrence_Of (Node (Next_Elmt (Sec_DT_Typ)), - Loc)))); + Loc)), + Num_Predef_Prims => + Number_Of_Predefined_Prims + (Parent_Typ))); if Num_Prims /= 0 then Append_To (Elab_Code, -- cgit v1.1 From 432c8cdddae4ad6439ac1f85b30919d5bb91d3e1 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 19 Aug 2019 08:36:44 +0000 Subject: [Ada] Legality of protected subp. implementing interface operations This patch refines the predicate that implements rule in RM 9.4 (11.9/2) Compiling b94.ads must yield: b94.ads:11:17: illegal overriding of subprogram inherited from interface b94.ads:11:17: first formal of "N" declared at line 8 must be of mode "out", "in out" or access-to-variable ---- package B94 is type Prot2_Int is protected interface; procedure J (PI : in Prot2_Int; N : in Integer) is null; procedure K (PI : in out Prot2_Int; N : in Integer) is null; procedure L (PI : out Prot2_Int; N : in Integer) is null; procedure M (PI : access Prot2_Int; N : in Integer) is null; procedure N (PI : access constant Prot2_Int; N : in Integer) is null; protected type Protected_2 is new Prot2_Int with procedure N (N : in Integer); -- ERROR: {7;1} end Protected_2; end B94; 2019-08-19 Ed Schonberg gcc/ada/ * sem_ch6.adb (Check_Synchronized_Overriding): Complete predicate that applies legality check in 9.4 (11.9/2): if an inherited subprogram is implemented by a protected procedure or entry, its first paarameter must be out, in_out or access_to_varible. From-SVN: r274655 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/sem_ch6.adb | 23 +++++++++++++++++++---- 2 files changed, 27 insertions(+), 4 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f193063..313a5ef 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-08-19 Ed Schonberg + + * sem_ch6.adb (Check_Synchronized_Overriding): Complete + predicate that applies legality check in 9.4 (11.9/2): if an + inherited subprogram is implemented by a protected procedure or + entry, its first paarameter must be out, in_out or + access_to_varible. + 2019-08-19 Javier Miranda PR ada/65696 diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index e176535..fb50ec7 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -7034,6 +7034,11 @@ package body Sem_Ch6 is In_Scope : Boolean; Typ : Entity_Id; + function Is_Valid_Formal (F : Entity_Id) return Boolean; + -- Predicate for legality rule in 9.4 (11.9/2): If an inherited + -- subprogram is implemented by a protected procedure or entry, + -- its first parameter must be out, in out, or access-to-variable. + function Matches_Prefixed_View_Profile (Prim_Params : List_Id; Iface_Params : List_Id) return Boolean; @@ -7042,6 +7047,19 @@ package body Sem_Ch6 is -- Iface_Params. Also determine if the type of first parameter of -- Iface_Params is an implemented interface. + ---------------------- + -- Is_Valid_Formal -- + ---------------------- + + function Is_Valid_Formal (F : Entity_Id) return Boolean is + begin + return + Ekind_In (F, E_In_Out_Parameter, E_Out_Parameter) + or else + (Nkind (Parameter_Type (Parent (F))) = N_Access_Definition + and then not Constant_Present (Parameter_Type (Parent (F)))); + end Is_Valid_Formal; + ----------------------------------- -- Matches_Prefixed_View_Profile -- ----------------------------------- @@ -7295,10 +7313,7 @@ package body Sem_Ch6 is if Ekind_In (Candidate, E_Entry, 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 + and then not Is_Valid_Formal (Formal) then null; -- cgit v1.1 From 92b635e518dfb3bc6829601c38a2c55ea8791887 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 19 Aug 2019 08:36:48 +0000 Subject: [Ada] Further cleanup in inlining machinery This adds missing boilerplate stuff. No functional changes. 2019-08-19 Eric Botcazou gcc/ada/ * inline.adb (Initialize, Lock): Deal with Called_Pending_Instantiations. From-SVN: r274656 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/inline.adb | 3 +++ 2 files changed, 8 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 313a5ef..c801498 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-19 Eric Botcazou + + * inline.adb (Initialize, Lock): Deal with + Called_Pending_Instantiations. + 2019-08-19 Ed Schonberg * sem_ch6.adb (Check_Synchronized_Overriding): Complete diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index f7bb1a9..22a50e2 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -4416,6 +4416,7 @@ package body Inline is procedure Initialize is begin Pending_Instantiations.Init; + Called_Pending_Instantiations.Init; Inlined_Bodies.Init; Successors.Init; Inlined.Init; @@ -4734,6 +4735,8 @@ package body Inline is begin Pending_Instantiations.Release; Pending_Instantiations.Locked := True; + Called_Pending_Instantiations.Release; + Called_Pending_Instantiations.Locked := True; Inlined_Bodies.Release; Inlined_Bodies.Locked := True; Successors.Release; -- cgit v1.1 From 6c87c83bb2a8a65f6f73d23ebb863a5c67e4c6c2 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 19 Aug 2019 08:36:53 +0000 Subject: [Ada] Lift restriction on instantiations that are compilation units This change lifts the restriction that was still present in the new on-demand instantiation scheme for the body of generics instantiated in non-main units. The instantiations that are compilation units were still dealt with in the old-fashioned way, that is to say the decision of instantiating the body was still made up front during the analysis of the instance declaration, instead of being deferred until after a call to an inlined subprogram is encountered. This should save a few more cycles when full inlining across units is enabled, but there should otherwise be no functional changes. 2019-08-19 Eric Botcazou gcc/ada/ * inline.adb (Add_Inlined_Body): Do not special-case instances that are compilation units. (Add_Pending_Instantiation): Likewise. (Instantiate_Body): Skip instantiations that are compilation units and have already been performed. * sem_ch12.adb (Needs_Body_Instantiated): Do not special-case instances that are compilation units. (Load_Parent_Of_Generic): Be prepared for parent that is a compilation unit but whose instantiation node has not been replaced. gcc/testsuite/ * gnat.dg/generic_inst12.adb, gnat.dg/generic_inst12_pkg1.adb, gnat.dg/generic_inst12_pkg1.ads, gnat.dg/generic_inst12_pkg2.ads: New testcase. From-SVN: r274657 --- gcc/ada/ChangeLog | 13 +++++++++++++ gcc/ada/inline.adb | 24 ++++++++++++++---------- gcc/ada/sem_ch12.adb | 35 +++++++++++++++++++++-------------- 3 files changed, 48 insertions(+), 24 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c801498..2ac5309 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,18 @@ 2019-08-19 Eric Botcazou + * inline.adb (Add_Inlined_Body): Do not special-case instances + that are compilation units. + (Add_Pending_Instantiation): Likewise. + (Instantiate_Body): Skip instantiations that are compilation + units and have already been performed. + * sem_ch12.adb (Needs_Body_Instantiated): Do not special-case + instances that are compilation units. + (Load_Parent_Of_Generic): Be prepared for parent that is a + compilation unit but whose instantiation node has not been + replaced. + +2019-08-19 Eric Botcazou + * inline.adb (Initialize, Lock): Deal with Called_Pending_Instantiations. diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 22a50e2..46daa48 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -611,12 +611,11 @@ package body Inline is Inst_Decl := Unit_Declaration_Node (Inst); -- Do not inline the instance if the body already exists, - -- or if the instance is a compilation unit, or else if - -- the instance node is simply missing. + -- or the instance node is simply missing. if Present (Corresponding_Body (Inst_Decl)) - or else Nkind (Parent (Inst_Decl)) = N_Compilation_Unit - or else No (Next (Inst_Decl)) + or else (Nkind (Parent (Inst_Decl)) /= N_Compilation_Unit + and then No (Next (Inst_Decl))) then Set_Is_Called (Inst); else @@ -797,13 +796,11 @@ package body Inline is To_Pending_Instantiations.Set (Act_Decl, Index); - -- If an instantiation is either a compilation unit or is in the main - -- unit or subunit or is a nested subprogram, then its body is needed - -- as per the analysis already done in Analyze_Package_Instantiation - -- and Analyze_Subprogram_Instantiation. + -- If an instantiation is in the main unit or subunit, or is a nested + -- subprogram, then its body is needed as per the analysis done in + -- Analyze_Package_Instantiation & Analyze_Subprogram_Instantiation. - if Nkind (Parent (Inst)) = N_Compilation_Unit - or else In_Main_Unit_Or_Subunit (Act_Decl_Id) + if In_Main_Unit_Or_Subunit (Act_Decl_Id) or else (Is_Subprogram (Act_Decl_Id) and then Is_Nested (Act_Decl_Id)) then @@ -4460,6 +4457,13 @@ package body Inline is if No (Info.Inst_Node) then null; + -- If the instantiation node is a package body, this means that the + -- instance is a compilation unit and the instantiation has already + -- been performed by Build_Instance_Compilation_Unit_Nodes. + + elsif Nkind (Info.Inst_Node) = N_Package_Body then + null; + elsif Nkind (Info.Act_Decl) = N_Package_Declaration then Instantiate_Package_Body (Info); Add_Scope_To_Clean (Defining_Entity (Info.Act_Decl)); diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index e94fc21..17de328 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3921,19 +3921,15 @@ package body Sem_Ch12 is return False; end if; - -- Here we have a special handling for back-end inlining: if the - -- instantiation is not a compilation unit, then we want to have - -- its body instantiated. The reason is that Might_Inline_Subp - -- does not catch all the cases (since it does not recurse into - -- nested packages) so this avoids the need to patch things up - -- at a later stage. Moreover the instantiations that are not - -- compilation units are only performed on demand when back-end + -- Here we have a special handling for back-end inlining: if inline + -- processing is required, then we unconditionally want to have the + -- body instantiated. The reason is that Might_Inline_Subp does not + -- catch all the cases (as it does not recurse into nested packages) + -- so this avoids the need to patch things up afterwards. Moreover, + -- these instantiations are only performed on demand when back-end -- inlining is enabled, so this causes very little extra work. - if Nkind (Parent (N)) /= N_Compilation_Unit - and then Inline_Processing_Required - and then Back_End_Inlining - then + if Inline_Processing_Required and then Back_End_Inlining then return True; end if; @@ -13699,15 +13695,26 @@ package body Sem_Ch12 is and then Nkind (Original_Node (True_Parent)) = N_Package_Instantiation then - -- Parent is a compilation unit that is an instantiation. - -- Instantiation node has been replaced with package decl. + -- Parent is a compilation unit that is an instantiation, and + -- instantiation node has been replaced with package decl. Inst_Node := Original_Node (True_Parent); exit; elsif Nkind (True_Parent) = N_Package_Declaration - and then Present (Generic_Parent (Specification (True_Parent))) + and then Nkind (Parent (True_Parent)) = N_Compilation_Unit + and then + Nkind (Unit (Parent (True_Parent))) = N_Package_Instantiation + then + -- Parent is a compilation unit that is an instantiation, but + -- instantiation node has not been replaced with package decl. + + Inst_Node := Unit (Parent (True_Parent)); + exit; + + elsif Nkind (True_Parent) = N_Package_Declaration and then Nkind (Parent (True_Parent)) /= N_Compilation_Unit + and then Present (Generic_Parent (Specification (True_Parent))) then -- Parent is an instantiation within another specification. -- Declaration for instance has been inserted before original -- cgit v1.1 From bd0feb3c614d33141062a5d5c7a4966a3b64d7bd Mon Sep 17 00:00:00 2001 From: Jerome Guitton Date: Mon, 19 Aug 2019 08:36:58 +0000 Subject: [Ada] Generate ada_target_properties Generate target-dependent info into a file named ada_target_properties. This information is used by tools for static analysis: they need to know the size of standard types for a given run-time library. This metadata is meant to be saved at the root of the run-time directory. 2019-08-19 Jerome Guitton gcc/ada/ * Makefile.rtl (system.o): New target to add generation of target properties. * gcc-interface/Makefile.in (install-gnatlib): Install ada_target_properties. From-SVN: r274658 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/Makefile.rtl | 12 ++++++++++++ gcc/ada/gcc-interface/Makefile.in | 2 ++ 3 files changed, 21 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2ac5309..1c98305 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-08-19 Jerome Guitton + + * Makefile.rtl (system.o): New target to add generation of + target properties. + * gcc-interface/Makefile.in (install-gnatlib): Install + ada_target_properties. + 2019-08-19 Eric Botcazou * inline.adb (Add_Inlined_Body): Do not special-case instances diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index d6dd151..c1a422f 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -2696,6 +2696,18 @@ setup-rts: force # propagation of exceptions cannot itself be compiled with checks that # may give rise to exceptions, e.g. stack overflow checks. +# Generate target-dependent info into a file named ada_target_properties. +# This information is used by tools for static analysis: they need to know +# the size of standard types for a given run-time library. This metadata +# is meant to be saved at the root of the run-time directory. + +ADA_TARGET_PROPERTIES = -gnatet=ada_target_properties + +system.o : system.ads + $(ADAC) -c $(ALL_ADAFLAGS) $(ADA_INCLUDES) $< \ + $(ADA_TARGET_PROPERTIES) \ + $(OUTPUT_OPTION) + # Force no sibling call optimization on s-traceb.o so the number of stack # frames to be skipped when computing a call chain is not modified by # optimization. We don't want inlining, either. diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index e9a4874..d4c9d15 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -516,6 +516,8 @@ install-gnatlib: ../stamp-gnatlib-$(RTSDIR) install-gcc-specs for file in $(RTSDIR)/*.ali; do \ $(INSTALL_DATA_DATE) $$file $(DESTDIR)$(ADA_RTL_OBJ_DIR); \ done + $(INSTALL_DATA_DATE) $(RTSDIR)/ada_target_properties \ + $(DESTDIR)$(ADA_RTL_OBJ_DIR)/../ -cd $(RTSDIR); for file in *$(arext);do \ $(INSTALL_DATA) $$file $(DESTDIR)$(ADA_RTL_OBJ_DIR); \ $(RANLIB_FOR_TARGET) $(DESTDIR)$(ADA_RTL_OBJ_DIR)/$$file; \ -- cgit v1.1 From 27ebda1930cef2ac484abcca124a4d6230feee08 Mon Sep 17 00:00:00 2001 From: Pierre-Marie de Rodat Date: Mon, 19 Aug 2019 08:37:03 +0000 Subject: [Ada] Import documentation from the RM for various runtime units 2019-08-19 Pierre-Marie de Rodat gcc/ada/ * libgnat/a-cgaaso.ads, libgnat/a-cgarso.ads, libgnat/a-cogeso.ads, libgnat/a-contai.ads, libgnat/a-locale.ads: Import documentation from the RM. From-SVN: r274659 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/libgnat/a-cgaaso.ads | 13 +++++++++++++ gcc/ada/libgnat/a-cgarso.ads | 16 +++++++++++++--- gcc/ada/libgnat/a-cogeso.ads | 16 ++++++++++++++++ gcc/ada/libgnat/a-contai.ads | 4 ++++ gcc/ada/libgnat/a-locale.ads | 16 ++++++++++++++++ 6 files changed, 68 insertions(+), 3 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1c98305..561e091 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-19 Pierre-Marie de Rodat + + * libgnat/a-cgaaso.ads, libgnat/a-cgarso.ads, + libgnat/a-cogeso.ads, libgnat/a-contai.ads, + libgnat/a-locale.ads: Import documentation from the RM. + 2019-08-19 Jerome Guitton * Makefile.rtl (system.o): New target to add generation of diff --git a/gcc/ada/libgnat/a-cgaaso.ads b/gcc/ada/libgnat/a-cgaaso.ads index 60bfd22..3622702 100644 --- a/gcc/ada/libgnat/a-cgaaso.ads +++ b/gcc/ada/libgnat/a-cgaaso.ads @@ -39,3 +39,16 @@ generic procedure Ada.Containers.Generic_Anonymous_Array_Sort (First, Last : Index_Type'Base); pragma Pure (Ada.Containers.Generic_Anonymous_Array_Sort); +-- Reorders the elements of Container such that the elements are sorted +-- smallest first as determined by the generic formal "<" operator provided. +-- Any exception raised during evaluation of "<" is propagated. +-- +-- The actual function for the generic formal function "<" is expected to +-- return the same value each time it is called with a particular pair of +-- element values. It should not modify Container and it should define a +-- strict weak ordering relationship: irreflexive, asymmetric, transitive, and +-- in addition, if x < y for any values x and y, then for all other values z, +-- (x < z) or (z < y). If the actual for "<" behaves in some other manner, +-- the behavior of the instance of Generic_Anonymous_Array_Sort is +-- unspecified. The number of times Generic_Anonymous_Array_Sort calls "<" is +-- unspecified. diff --git a/gcc/ada/libgnat/a-cgarso.ads b/gcc/ada/libgnat/a-cgarso.ads index 77281b5..1a64673 100644 --- a/gcc/ada/libgnat/a-cgarso.ads +++ b/gcc/ada/libgnat/a-cgarso.ads @@ -18,9 +18,19 @@ generic type Element_Type is private; type Array_Type is array (Index_Type range <>) of Element_Type; - with function "<" (Left, Right : Element_Type) - return Boolean is <>; + with function "<" (Left, Right : Element_Type) return Boolean is <>; procedure Ada.Containers.Generic_Array_Sort (Container : in out Array_Type); - pragma Pure (Ada.Containers.Generic_Array_Sort); +-- Reorders the elements of Container such that the elements are sorted +-- smallest first as determined by the generic formal "<" operator provided. +-- Any exception raised during evaluation of "<" is propagated. +-- +-- The actual function for the generic formal function "<" is expected to +-- return the same value each time it is called with a particular pair of +-- element values. It should not modify Container and it should define a +-- strict weak ordering relationship: irreflexive, asymmetric, transitive, and +-- in addition, if x < y for any values x and y, then for all other values z, +-- (x < z) or (z < y). If the actual for "<" behaves in some other manner, +-- the behavior of the instance of Generic_Array_Sort is unspecified. The +-- number of times Generic_Array_Sort calls "<" is unspecified. diff --git a/gcc/ada/libgnat/a-cogeso.ads b/gcc/ada/libgnat/a-cogeso.ads index a707072..e77558f 100644 --- a/gcc/ada/libgnat/a-cogeso.ads +++ b/gcc/ada/libgnat/a-cogeso.ads @@ -38,3 +38,19 @@ generic procedure Ada.Containers.Generic_Sort (First, Last : Index_Type'Base); pragma Pure (Ada.Containers.Generic_Sort); +-- Reorders the elements of an indexable structure, over the range +-- First .. Last, such that the elements are sorted in the ordering determined +-- by the generic formal function Before; Before should return True if Left is +-- to be sorted before Right. The generic formal Before compares the elements +-- having the given indices, and the generic formal Swap exchanges the values +-- of the indicated elements. Any exception raised during evaluation of Before +-- or Swap is propagated. +-- +-- The actual function for the generic formal function "<" is expected to +-- return the same value each time it is called with a particular pair of +-- element values. It should not modify Container and it should define a +-- strict weak ordering relationship: irreflexive, asymmetric, transitive, and +-- in addition, if x < y for any values x and y, then for all other values z, +-- (x < z) or (z < y). If the actual for "<" behaves in some other manner, +-- the behavior of the instance of Generic_Sort is unspecified. The number of +-- times Generic_Sort calls "<" is unspecified. diff --git a/gcc/ada/libgnat/a-contai.ads b/gcc/ada/libgnat/a-contai.ads index be8a808..d6189a3 100644 --- a/gcc/ada/libgnat/a-contai.ads +++ b/gcc/ada/libgnat/a-contai.ads @@ -17,8 +17,12 @@ package Ada.Containers is pragma Pure; type Hash_Type is mod 2**32; + -- Represents the range of the result of a hash function + type Count_Type is range 0 .. 2**31 - 1; + -- Represents the (potential or actual) number of elements of a container Capacity_Error : exception; + -- Raised when the capacity of a container is exceeded end Ada.Containers; diff --git a/gcc/ada/libgnat/a-locale.ads b/gcc/ada/libgnat/a-locale.ads index 43ba5bf..314001a 100644 --- a/gcc/ada/libgnat/a-locale.ads +++ b/gcc/ada/libgnat/a-locale.ads @@ -19,18 +19,34 @@ package Ada.Locales is pragma Preelaborate (Locales); pragma Remote_Types (Locales); + -- A locale identifies a geopolitical place or region and its associated + -- language, which can be used to determine other + -- internationalization-related characteristics. The active locale is the + -- locale associated with the partition of the current task. + type Language_Code is new String (1 .. 3) with Dynamic_Predicate => (for all E of Language_Code => E in 'a' .. 'z'); + -- Lower-case string representation of an ISO 639-3 alpha-3 code that + -- identifies a language. type Country_Code is new String (1 .. 2) with Dynamic_Predicate => (for all E of Country_Code => E in 'A' .. 'Z'); + -- Upper-case string representation of an ISO 3166-1 alpha-2 code that + -- identifies a country. Language_Unknown : constant Language_Code := "und"; Country_Unknown : constant Country_Code := "ZZ"; function Language return Language_Code; + -- Returns the code of the language associated with the active locale. If + -- the Language_Code associated with the active locale cannot be determined + -- from the environment, then Language returns Language_Unknown. + function Country return Country_Code; + -- Returns the code of the country associated with the active locale. If + -- the Country_Code associated with the active locale cannot be determined + -- from the environment, then Country returns Country_Unknown. end Ada.Locales; -- cgit v1.1 From 382b0e9771d77d482f6765454ec884936b62b15b Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Mon, 19 Aug 2019 08:37:09 +0000 Subject: [Ada] Incorrect code for -gnateV switch This patch corrects the code generated by the -gnateV switch in the case of a private type whose full type is a modular type, removing spurious run-time failures. In addition, this corrects the initialization of exception occurrences in exception handlers to avoid leaving data uninitialized, which caused -gnateV to raise spurious errors. 2019-08-19 Bob Duff gcc/ada/ * exp_attr.adb (Attribute_Valid): Correct the handling of private types where the full type is modular. System.Address is an example. Otherwise, we convert uncheckedly to a signed type, so we get an incorrect range 0 .. -1, for which all values will fail. The 'Valid attribute is illegal for such types, but we generate such illegal attribute_references for 'Valid_Scalars, and we generate 'Valid_Scalars when the -gnateV switch is used. Rename Btyp --> PBtyp to avoid hiding the outer Btyp, which was confusing. * libgnat/a-except.adb: Set the Exception_Raised component. Otherwise, we have incorrect reads of invalid data. gcc/testsuite/ * gnat.dg/valid_scalars2.adb: New testcase. From-SVN: r274660 --- gcc/ada/ChangeLog | 14 +++++++++++ gcc/ada/exp_attr.adb | 56 +++++++++++++++++++++++--------------------- gcc/ada/libgnat/a-except.adb | 1 + 3 files changed, 44 insertions(+), 27 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 561e091..499a489 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2019-08-19 Bob Duff + + * exp_attr.adb (Attribute_Valid): Correct the handling of + private types where the full type is modular. System.Address is + an example. Otherwise, we convert uncheckedly to a signed type, + so we get an incorrect range 0 .. -1, for which all values will + fail. The 'Valid attribute is illegal for such types, but we + generate such illegal attribute_references for 'Valid_Scalars, + and we generate 'Valid_Scalars when the -gnateV switch is used. + Rename Btyp --> PBtyp to avoid hiding the outer Btyp, which was + confusing. + * libgnat/a-except.adb: Set the Exception_Raised component. + Otherwise, we have incorrect reads of invalid data. + 2019-08-19 Pierre-Marie de Rodat * libgnat/a-cgaaso.ads, libgnat/a-cgarso.ads, diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index d90dc29..306c1b5 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -6545,7 +6545,7 @@ package body Exp_Attr is -- See separate sections below for the generated code in each case. when Attribute_Valid => Valid : declare - Btyp : Entity_Id := Base_Type (Ptyp); + PBtyp : Entity_Id := Base_Type (Ptyp); Save_Validity_Checks_On : constant Boolean := Validity_Checks_On; -- Save the validity checking mode. We always turn off validity @@ -6555,7 +6555,7 @@ package body Exp_Attr is function Make_Range_Test return Node_Id; -- Build the code for a range test of the form - -- Btyp!(Pref) in Btyp!(Ptyp'First) .. Btyp!(Ptyp'Last) + -- PBtyp!(Pref) in PBtyp!(Ptyp'First) .. PBtyp!(Ptyp'Last) --------------------- -- Make_Range_Test -- @@ -6594,16 +6594,16 @@ package body Exp_Attr is return Make_In (Loc, - Left_Opnd => Unchecked_Convert_To (Btyp, Temp), + Left_Opnd => Unchecked_Convert_To (PBtyp, Temp), Right_Opnd => Make_Range (Loc, Low_Bound => - Unchecked_Convert_To (Btyp, + Unchecked_Convert_To (PBtyp, Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Ptyp, Loc), Attribute_Name => Name_First)), High_Bound => - Unchecked_Convert_To (Btyp, + Unchecked_Convert_To (PBtyp, Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Ptyp, Loc), Attribute_Name => Name_Last)))); @@ -6631,8 +6631,8 @@ package body Exp_Attr is -- Retrieve the base type. Handle the case where the base type is a -- private enumeration type. - if Is_Private_Type (Btyp) and then Present (Full_View (Btyp)) then - Btyp := Full_View (Btyp); + if Is_Private_Type (PBtyp) and then Present (Full_View (PBtyp)) then + PBtyp := Full_View (PBtyp); end if; -- Floating-point case. This case is handled by the Valid attribute @@ -6665,7 +6665,7 @@ package body Exp_Attr is begin -- The C and AAMP back-ends handle Valid for fpt types - if Modify_Tree_For_C or else Float_Rep (Btyp) = AAMP then + if Modify_Tree_For_C or else Float_Rep (PBtyp) = AAMP then Analyze_And_Resolve (Pref, Ptyp); Set_Etype (N, Standard_Boolean); Set_Analyzed (N); @@ -6758,13 +6758,13 @@ package body Exp_Attr is -- The way we do the range check is simply to create the -- expression: Valid (N) and then Base_Type(Pref) in Typ. - if not Subtypes_Statically_Match (Ptyp, Btyp) then + if not Subtypes_Statically_Match (Ptyp, PBtyp) then Rewrite (N, Make_And_Then (Loc, Left_Opnd => Relocate_Node (N), Right_Opnd => Make_In (Loc, - Left_Opnd => Convert_To (Btyp, Pref), + Left_Opnd => Convert_To (PBtyp, Pref), Right_Opnd => New_Occurrence_Of (Ptyp, Loc)))); end if; end Float_Valid; @@ -6793,24 +6793,24 @@ package body Exp_Attr is -- (X >= type(X)'First and then type(X)'Last <= X) elsif Is_Enumeration_Type (Ptyp) - and then Present (Enum_Pos_To_Rep (Btyp)) + and then Present (Enum_Pos_To_Rep (PBtyp)) then Tst := Make_Op_Ge (Loc, Left_Opnd => Make_Function_Call (Loc, Name => - New_Occurrence_Of (TSS (Btyp, TSS_Rep_To_Pos), Loc), + New_Occurrence_Of (TSS (PBtyp, TSS_Rep_To_Pos), Loc), Parameter_Associations => New_List ( Pref, New_Occurrence_Of (Standard_False, Loc))), Right_Opnd => Make_Integer_Literal (Loc, 0)); - if Ptyp /= Btyp + if Ptyp /= PBtyp and then - (Type_Low_Bound (Ptyp) /= Type_Low_Bound (Btyp) + (Type_Low_Bound (Ptyp) /= Type_Low_Bound (PBtyp) or else - Type_High_Bound (Ptyp) /= Type_High_Bound (Btyp)) + Type_High_Bound (Ptyp) /= Type_High_Bound (PBtyp)) then -- The call to Make_Range_Test will create declarations -- that need a proper insertion point, but Pref is now @@ -6843,16 +6843,16 @@ package body Exp_Attr is -- test has to take this into account, and the proper form of the -- test is: - -- Btyp!(Pref) < Btyp!(Ptyp'Range_Length) + -- PBtyp!(Pref) < PBtyp!(Ptyp'Range_Length) elsif Has_Biased_Representation (Ptyp) then - Btyp := RTE (RE_Unsigned_32); + PBtyp := RTE (RE_Unsigned_32); Rewrite (N, Make_Op_Lt (Loc, Left_Opnd => - Unchecked_Convert_To (Btyp, Duplicate_Subexpr (Pref)), + Unchecked_Convert_To (PBtyp, Duplicate_Subexpr (Pref)), Right_Opnd => - Unchecked_Convert_To (Btyp, + Unchecked_Convert_To (PBtyp, Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Ptyp, Loc), Attribute_Name => Name_Range_Length)))); @@ -6867,11 +6867,11 @@ package body Exp_Attr is -- the Valid attribute is exactly that this test does not work). -- What will work is: - -- Btyp!(X) >= Btyp!(type(X)'First) + -- PBtyp!(X) >= PBtyp!(type(X)'First) -- and then - -- Btyp!(X) <= Btyp!(type(X)'Last) + -- PBtyp!(X) <= PBtyp!(type(X)'Last) - -- where Btyp is an integer type large enough to cover the full + -- where PBtyp is an integer type large enough to cover the full -- range of possible stored values (i.e. it is chosen on the basis -- of the size of the type, not the range of the values). We write -- this as two tests, rather than a range check, so that static @@ -6895,11 +6895,13 @@ package body Exp_Attr is -- correct, even though a value greater than 127 looks signed to a -- signed comparison. - elsif Is_Unsigned_Type (Ptyp) then + elsif Is_Unsigned_Type (Ptyp) + or else (Is_Private_Type (Ptyp) and then Is_Unsigned_Type (Btyp)) + then if Esize (Ptyp) <= 32 then - Btyp := RTE (RE_Unsigned_32); + PBtyp := RTE (RE_Unsigned_32); else - Btyp := RTE (RE_Unsigned_64); + PBtyp := RTE (RE_Unsigned_64); end if; Rewrite (N, Make_Range_Test); @@ -6908,9 +6910,9 @@ package body Exp_Attr is else if Esize (Ptyp) <= Esize (Standard_Integer) then - Btyp := Standard_Integer; + PBtyp := Standard_Integer; else - Btyp := Universal_Integer; + PBtyp := Universal_Integer; end if; Rewrite (N, Make_Range_Test); diff --git a/gcc/ada/libgnat/a-except.adb b/gcc/ada/libgnat/a-except.adb index ebb76a7..8b0a31c 100644 --- a/gcc/ada/libgnat/a-except.adb +++ b/gcc/ada/libgnat/a-except.adb @@ -1624,6 +1624,7 @@ package body Ada.Exceptions is Target.Machine_Occurrence := System.Null_Address; Target.Msg_Length := Source.Msg_Length; Target.Num_Tracebacks := Source.Num_Tracebacks; + Target.Exception_Raised := Source.Exception_Raised; Target.Pid := Source.Pid; Target.Msg (1 .. Target.Msg_Length) := -- cgit v1.1 From c70220382300ae326ad63fe54c5a32da202d1f13 Mon Sep 17 00:00:00 2001 From: Dmitriy Anisimkov Date: Mon, 19 Aug 2019 08:37:13 +0000 Subject: [Ada] Conversion routines between GNAT.OS_Lib.OS_Time and long integer The new routines convert back and forth between private type OS_Time and a long integer which can be used in package Ada.Calendar.Conversions routines to convert to Ada.Calendar.Time. 2019-08-19 Dmitriy Anisimkov gcc/ada/ * libgnat/s-os_lib.ads, libgnat/s-os_lib.adb (To_Ada, To_C): New routines. From-SVN: r274661 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/libgnat/s-os_lib.adb | 18 ++++++++++++++++++ gcc/ada/libgnat/s-os_lib.ads | 11 +++++++++++ 3 files changed, 34 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 499a489..932ff97 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-19 Dmitriy Anisimkov + + * libgnat/s-os_lib.ads, libgnat/s-os_lib.adb (To_Ada, To_C): New + routines. + 2019-08-19 Bob Duff * exp_attr.adb (Attribute_Valid): Correct the handling of diff --git a/gcc/ada/libgnat/s-os_lib.adb b/gcc/ada/libgnat/s-os_lib.adb index c3c1979..258cd64 100644 --- a/gcc/ada/libgnat/s-os_lib.adb +++ b/gcc/ada/libgnat/s-os_lib.adb @@ -2979,6 +2979,15 @@ package body System.OS_Lib is end loop; end Spawn_Internal; + ------------ + -- To_Ada -- + ------------ + + function To_Ada (Time : time_t) return OS_Time is + begin + return OS_Time (Time); + end To_Ada; + --------------------------- -- To_Path_String_Access -- --------------------------- @@ -3008,6 +3017,15 @@ package body System.OS_Lib is return Return_Val; end To_Path_String_Access; + ---------- + -- To_C -- + ---------- + + function To_C (Time : OS_Time) return time_t is + begin + return time_t (Time); + end To_C; + ------------------ -- Wait_Process -- ------------------ diff --git a/gcc/ada/libgnat/s-os_lib.ads b/gcc/ada/libgnat/s-os_lib.ads index 3e8c21d..99406e9 100644 --- a/gcc/ada/libgnat/s-os_lib.ads +++ b/gcc/ada/libgnat/s-os_lib.ads @@ -164,6 +164,15 @@ package System.OS_Lib is -- component parts to be interpreted in the local time zone, and returns -- an OS_Time. Returns Invalid_Time if the creation fails. + subtype time_t is Long_Integer; + -- C time_t type of the time representation + + function To_C (Time : OS_Time) return time_t; + -- Convert OS_Time to C time_t type + + function To_Ada (Time : time_t) return OS_Time; + -- Convert C time_t type to OS_Time + ---------------- -- File Stuff -- ---------------- @@ -1107,6 +1116,8 @@ private pragma Inline (">"); pragma Inline ("<="); pragma Inline (">="); + pragma Inline (To_C); + pragma Inline (To_Ada); type Process_Id is new Integer; Invalid_Pid : constant Process_Id := -1; -- cgit v1.1 From fcef060c9b321edcb24a56616588e712c22029ba Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 19 Aug 2019 08:37:18 +0000 Subject: [Ada] Crash on object initialization that is call to expression function This patch fixes a compiler abort on an object declaration for a class-wide type whose expression is a call to an expression function that returns type extension. 2019-08-19 Ed Schonberg gcc/ada/ * sem_res.adb (Resolve_Call): A call to an expression function freezes when expander is active, unless the call appears within the body of another expression function, gcc/testsuite/ * gnat.dg/expr_func9.adb: New testcase. From-SVN: r274662 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/sem_res.adb | 4 +++- 2 files changed, 9 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 932ff97..1f490b3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-19 Ed Schonberg + + * sem_res.adb (Resolve_Call): A call to an expression function + freezes when expander is active, unless the call appears within + the body of another expression function, + 2019-08-19 Dmitriy Anisimkov * libgnat/s-os_lib.ads, libgnat/s-os_lib.adb (To_Ada, To_C): New diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 8f2e358..7a52b90 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -6314,13 +6314,15 @@ package body Sem_Res is -- an expression function may appear when it is part of a default -- expression in a call to an initialization procedure, and must be -- frozen now, even if the body is inserted at a later point. + -- Otherwise, the call freezes the expression if expander is active, + -- for example as part of an object declaration. if Is_Entity_Name (Subp) and then not In_Spec_Expression and then not Is_Expression_Function_Or_Completion (Current_Scope) and then (not Is_Expression_Function_Or_Completion (Entity (Subp)) - or else Scope (Entity (Subp)) = Current_Scope) + or else Expander_Active) then if Is_Expression_Function (Entity (Subp)) then -- cgit v1.1 From bfa6962fc25e2e24b3a5299095e933f9b57bb6e0 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Mon, 19 Aug 2019 08:37:23 +0000 Subject: [Ada] Suppress warnings on unreferenced parameters of dispatching ops If the -gnatwf switch is used to activate warnings on unreferenced formal parameters, the warning is no longer given if the subprogram is dispatching, because such warnings tend to be noise. It is quite common to have a parameter that is necessary just because the subprogram is overriding, or just because we need a controlling parameter for the dispatch. 2019-08-19 Bob Duff gcc/ada/ * sem_warn.adb (Warn_On_Unreferenced_Entity): Suppress warning on formal parameters of dispatching operations. gcc/testsuite/ * gnat.dg/warn29.adb, gnat.dg/warn29.ads: New testcase. From-SVN: r274663 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem_warn.adb | 30 +++++++++++++++++++++++++----- 2 files changed, 30 insertions(+), 5 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1f490b3..84c2239 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-19 Bob Duff + + * sem_warn.adb (Warn_On_Unreferenced_Entity): Suppress warning + on formal parameters of dispatching operations. + 2019-08-19 Ed Schonberg * sem_res.adb (Resolve_Call): A call to an expression function diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index ca6515c..8f85057 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -4407,11 +4407,31 @@ package body Sem_Warn is E := Body_E; end if; - if not Is_Trivial_Subprogram (Scope (E)) then - Error_Msg_NE -- CODEFIX - ("?u?formal parameter & is not referenced!", - E, Spec_E); - end if; + declare + B : constant Node_Id := Parent (Parent (Scope (E))); + S : Entity_Id := Empty; + begin + if Nkind_In (B, + N_Expression_Function, + N_Subprogram_Body, + N_Subprogram_Renaming_Declaration) + then + S := Corresponding_Spec (B); + end if; + + -- Do not warn for dispatching operations, because + -- that causes too much noise. Also do not warn for + -- trivial subprograms. + + if (not Present (S) + or else not Is_Dispatching_Operation (S)) + and then not Is_Trivial_Subprogram (Scope (E)) + then + Error_Msg_NE -- CODEFIX + ("?u?formal parameter & is not referenced!", + E, Spec_E); + end if; + end; end if; end if; -- cgit v1.1 From 8fafa0b42000f5fa0284f8e3308f233a41843461 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 19 Aug 2019 08:37:28 +0000 Subject: [Ada] Fix bogus compilation error with Elaborate_Body and -gnatN This fixes a bogus compilation error when a unit with SPARK_Mode containing a pragma Elaborate_Body is with-ed by a generic unit containing an inlined subprogram, and front-end inlining is enabled. 2019-08-19 Eric Botcazou gcc/ada/ * sem_prag.adb (Is_Before_First_Decl): Deal with rewritten pragmas. gcc/testsuite/ * gnat.dg/elab8.adb, gnat.dg/elab8_gen.adb, gnat.dg/elab8_gen.ads, gnat.dg/elab8_pkg.adb, gnat.dg/elab8_pkg.ads: New testcase. From-SVN: r274664 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem_prag.adb | 5 +++-- 2 files changed, 8 insertions(+), 2 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 84c2239..f01e411 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-19 Eric Botcazou + + * sem_prag.adb (Is_Before_First_Decl): Deal with rewritten + pragmas. + 2019-08-19 Bob Duff * sem_warn.adb (Warn_On_Unreferenced_Entity): Suppress warning diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 035b0ee..993a419d 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -7146,10 +7146,11 @@ package body Sem_Prag is Item : Node_Id := First (Decls); begin - -- Only other pragmas can come before this pragma + -- Only other pragmas can come before this pragma, but they might + -- have been rewritten so check the original node. loop - if No (Item) or else Nkind (Item) /= N_Pragma then + if No (Item) or else Nkind (Original_Node (Item)) /= N_Pragma then return False; elsif Item = Pragma_Node then -- cgit v1.1 From c27a8bce8a2d215cf265d15f8b57f379ad4d16a0 Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Mon, 19 Aug 2019 08:37:34 +0000 Subject: [Ada] Einfo: update comments for E_Function and E_Procedure 2019-08-19 Gary Dismukes gcc/ada/ * einfo.ads (E_Function, E_Procedure): Update comments to reflect that Renamed_Entity is also used for nongeneric subprograms. From-SVN: r274665 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/einfo.ads | 6 +++--- 2 files changed, 9 insertions(+), 3 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f01e411..46121c5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-19 Gary Dismukes + + * einfo.ads (E_Function, E_Procedure): Update comments to + reflect that Renamed_Entity is also used for nongeneric + subprograms. + 2019-08-19 Eric Botcazou * sem_prag.adb (Is_Before_First_Decl): Deal with rewritten diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index b879753..089960a 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -4674,7 +4674,7 @@ package Einfo is -- They all overlap because they are supposed to apply to different entity -- kinds. They are semantically related, and have the following intended uses: --- a) Renamed_Entity appplies to entities in renaming declarations that rename +-- a) Renamed_Entity applies to entities in renaming declarations that rename -- an entity, so the value of the attribute IS an entity. This applies to -- generic renamings, package renamings, exception renamings, and subprograms -- renamings that rename a subprogram (rather than an attribute, an entry, a @@ -6141,7 +6141,7 @@ package Einfo is -- DTC_Entity (Node16) -- First_Entity (Node17) -- Alias (Node18) (non-generic case only) - -- Renamed_Entity (Node18) (generic case only) + -- Renamed_Entity (Node18) -- Extra_Accessibility_Of_Result (Node19) (non-generic case only) -- Last_Entity (Node20) -- Interface_Name (Node21) @@ -6467,7 +6467,7 @@ package Einfo is -- DTC_Entity (Node16) -- First_Entity (Node17) -- Alias (Node18) (non-generic case only) - -- Renamed_Entity (Node18) (generic case only) + -- Renamed_Entity (Node18) -- Receiving_Entry (Node19) (non-generic case only) -- Last_Entity (Node20) -- Interface_Name (Node21) -- cgit v1.1 From 8fd97fcdba9da64bfd0988122e012057d0a6ed40 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Mon, 19 Aug 2019 08:37:39 +0000 Subject: [Ada] Fix documentation for stream oriented attributes 2019-08-19 Bob Duff gcc/ada/ * doc/gnat_rm/implementation_advice.rst: Fix documentation for stream oriented attributes. * gnat_rm.texi: Regenerate. From-SVN: r274666 --- gcc/ada/ChangeLog | 6 +++++ gcc/ada/doc/gnat_rm/implementation_advice.rst | 28 ++++++++++---------- gcc/ada/gnat_rm.texi | 38 +++++++++++++-------------- 3 files changed, 39 insertions(+), 33 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 46121c5..e59b709 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-19 Bob Duff + + * doc/gnat_rm/implementation_advice.rst: Fix documentation for + stream oriented attributes. + * gnat_rm.texi: Regenerate. + 2019-08-19 Gary Dismukes * einfo.ads (E_Function, E_Procedure): Update comments to diff --git a/gcc/ada/doc/gnat_rm/implementation_advice.rst b/gcc/ada/doc/gnat_rm/implementation_advice.rst index b006f32..31376d9 100644 --- a/gcc/ada/doc/gnat_rm/implementation_advice.rst +++ b/gcc/ada/doc/gnat_rm/implementation_advice.rst @@ -703,23 +703,23 @@ Followed. .. index:: Stream oriented attributes -RM 13.13.2(17): Stream Oriented Attributes -========================================== +RM 13.13.2(1.6): Stream Oriented Attributes +=========================================== + + "If not specified, the value of Stream_Size for an elementary type + should be the number of bits that corresponds to the minimum number of + stream elements required by the first subtype of the type, rounded up + to the nearest factor or multiple of the word size that is also a + multiple of the stream element size." - "If a stream element is the same size as a storage element, then the - normal in-memory representation should be used by ``Read`` and - ``Write`` for scalar objects. Otherwise, ``Read`` and ``Write`` - should use the smallest number of stream elements needed to represent - all values in the base range of the scalar type." +Followed, except that the number of stream elements is a power of 2. +The Stream_Size may be used to override the default choice. -Followed. By default, GNAT uses the interpretation suggested by AI-195, -which specifies using the size of the first subtype. However, such an implementation is based on direct binary -representations and is therefore target- and endianness-dependent. -To address this issue, GNAT also supplies an alternate implementation -of the stream attributes ``Read`` and ``Write``, -which uses the target-independent XDR standard representation -for scalar types. +representations and is therefore target- and endianness-dependent. To +address this issue, GNAT also supplies an alternate implementation of +the stream attributes ``Read`` and ``Write``, which uses the +target-independent XDR standard representation for scalar types. .. index:: XDR representation diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 58ff6af..be31ed8 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -577,7 +577,7 @@ Implementation Advice * RM 13.9(14-17); Unchecked Conversion: RM 13 9 14-17 Unchecked Conversion. * RM 13.11(23-25); Implicit Heap Usage: RM 13 11 23-25 Implicit Heap Usage. * RM 13.11.2(17); Unchecked Deallocation: RM 13 11 2 17 Unchecked Deallocation. -* RM 13.13.2(17); Stream Oriented Attributes: RM 13 13 2 17 Stream Oriented Attributes. +* RM 13.13.2(1.6); Stream Oriented Attributes: RM 13 13 2 1 6 Stream Oriented Attributes. * RM A.1(52); Names of Predefined Numeric Types: RM A 1 52 Names of Predefined Numeric Types. * RM A.3.2(49); Ada.Characters.Handling: RM A 3 2 49 Ada Characters Handling. * RM A.4.4(106); Bounded-Length String Handling: RM A 4 4 106 Bounded-Length String Handling. @@ -13845,7 +13845,7 @@ case the text describes what GNAT does and why. * RM 13.9(14-17); Unchecked Conversion: RM 13 9 14-17 Unchecked Conversion. * RM 13.11(23-25); Implicit Heap Usage: RM 13 11 23-25 Implicit Heap Usage. * RM 13.11.2(17); Unchecked Deallocation: RM 13 11 2 17 Unchecked Deallocation. -* RM 13.13.2(17); Stream Oriented Attributes: RM 13 13 2 17 Stream Oriented Attributes. +* RM 13.13.2(1.6); Stream Oriented Attributes: RM 13 13 2 1 6 Stream Oriented Attributes. * RM A.1(52); Names of Predefined Numeric Types: RM A 1 52 Names of Predefined Numeric Types. * RM A.3.2(49); Ada.Characters.Handling: RM A 3 2 49 Ada Characters Handling. * RM A.4.4(106); Bounded-Length String Handling: RM A 4 4 106 Bounded-Length String Handling. @@ -14846,7 +14846,7 @@ Followed. @geindex Unchecked deallocation -@node RM 13 11 2 17 Unchecked Deallocation,RM 13 13 2 17 Stream Oriented Attributes,RM 13 11 23-25 Implicit Heap Usage,Implementation Advice +@node RM 13 11 2 17 Unchecked Deallocation,RM 13 13 2 1 6 Stream Oriented Attributes,RM 13 11 23-25 Implicit Heap Usage,Implementation Advice @anchor{gnat_rm/implementation_advice rm-13-11-2-17-unchecked-deallocation}@anchor{235} @section RM 13.11.2(17): Unchecked Deallocation @@ -14861,28 +14861,28 @@ Followed. @geindex Stream oriented attributes -@node RM 13 13 2 17 Stream Oriented Attributes,RM A 1 52 Names of Predefined Numeric Types,RM 13 11 2 17 Unchecked Deallocation,Implementation Advice -@anchor{gnat_rm/implementation_advice rm-13-13-2-17-stream-oriented-attributes}@anchor{236} -@section RM 13.13.2(17): Stream Oriented Attributes +@node RM 13 13 2 1 6 Stream Oriented Attributes,RM A 1 52 Names of Predefined Numeric Types,RM 13 11 2 17 Unchecked Deallocation,Implementation Advice +@anchor{gnat_rm/implementation_advice rm-13-13-2-1-6-stream-oriented-attributes}@anchor{236} +@section RM 13.13.2(1.6): Stream Oriented Attributes @quotation -"If a stream element is the same size as a storage element, then the -normal in-memory representation should be used by @code{Read} and -@code{Write} for scalar objects. Otherwise, @code{Read} and @code{Write} -should use the smallest number of stream elements needed to represent -all values in the base range of the scalar type." +"If not specified, the value of Stream_Size for an elementary type +should be the number of bits that corresponds to the minimum number of +stream elements required by the first subtype of the type, rounded up +to the nearest factor or multiple of the word size that is also a +multiple of the stream element size." @end quotation -Followed. By default, GNAT uses the interpretation suggested by AI-195, -which specifies using the size of the first subtype. +Followed, except that the number of stream elements is a power of 2. +The Stream_Size may be used to override the default choice. + However, such an implementation is based on direct binary -representations and is therefore target- and endianness-dependent. -To address this issue, GNAT also supplies an alternate implementation -of the stream attributes @code{Read} and @code{Write}, -which uses the target-independent XDR standard representation -for scalar types. +representations and is therefore target- and endianness-dependent. To +address this issue, GNAT also supplies an alternate implementation of +the stream attributes @code{Read} and @code{Write}, which uses the +target-independent XDR standard representation for scalar types. @geindex XDR representation @@ -14916,7 +14916,7 @@ Rebuild the GNAT run-time library as documented in the @emph{GNAT and Libraries} section of the @cite{GNAT User's Guide}. @end itemize -@node RM A 1 52 Names of Predefined Numeric Types,RM A 3 2 49 Ada Characters Handling,RM 13 13 2 17 Stream Oriented Attributes,Implementation Advice +@node RM A 1 52 Names of Predefined Numeric Types,RM A 3 2 49 Ada Characters Handling,RM 13 13 2 1 6 Stream Oriented Attributes,Implementation Advice @anchor{gnat_rm/implementation_advice rm-a-1-52-names-of-predefined-numeric-types}@anchor{237} @section RM A.1(52): Names of Predefined Numeric Types -- cgit v1.1