diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 37 | ||||
| -rw-r--r-- | gcc/ada/a-except-2005.adb | 39 | ||||
| -rw-r--r-- | gcc/ada/a-except.adb | 52 | ||||
| -rw-r--r-- | gcc/ada/exp_attr.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/exp_ch11.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/exp_ch7.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/exp_dbug.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/exp_util.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/projects.texi | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_ch5.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/types.ads | 18 | ||||
| -rw-r--r-- | gcc/ada/types.h | 5 |
13 files changed, 148 insertions, 73 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5b18da40103..2ccfdf417ca 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,42 @@ 2014-07-29 Robert Dewar <dewar@adacore.com> + * exp_attr.adb, types.ads, types.h, exp_ch11.adb, a-except.adb, + a-except-2005.adb: Add new reason code PE_Stream_Operation_Not_Allowed, + and then use it when a stream operation is used from a library generic + when the restriction (No_Streams) is active. + +2014-07-29 Thomas Quinot <quinot@adacore.com> + + * projects.texi: Fix minor typo. + +2014-07-29 Yannick Moy <moy@adacore.com> + + * sem_attr.adb (Analyze_Attribute): Fix generation of warning. + +2014-07-29 Arnaud Charlet <charlet@adacore.com> + + * sem_ch5.adb (Check_Unreachable_Code): Do not remove code in + CodePeer mode. + +2014-07-29 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_ch7.adb (Find_Last_Init): Add local variable + Deep_Init_Found. Check the statement immediately following the + declaration if [Deep_]Initialization was not found. + +2014-07-29 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_util.adb (Is_Aliased): It appears that + 'reference-d and renamed objects still play some role in Boolean + expression with actions and cannot be finalized immediately. + +2014-07-29 Ed Schonberg <schonberg@adacore.com> + + * exp_dbug.adb (Qualify_Needed): For debugging purposes, + Loop names are not part of the full qualification of entity names. + +2014-07-29 Robert Dewar <dewar@adacore.com> + * einfo.adb (Has_Protected): Test base type. * sem_ch4.adb (Analyze_Allocator): Reorganize code to make sure that we always properly check No_Protected_Type_Allocators. diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb index 7ed9e0302bd..52de66f2187 100644 --- a/gcc/ada/a-except-2005.adb +++ b/gcc/ada/a-except-2005.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, 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- -- @@ -456,16 +456,18 @@ package body Ada.Exceptions is (File : System.Address; Line : Integer); procedure Rcheck_PE_Missing_Return (File : System.Address; Line : Integer); + procedure Rcheck_PE_Non_Transportable_Actual + (File : System.Address; Line : Integer); procedure Rcheck_PE_Overlaid_Controlled_Object (File : System.Address; Line : Integer); procedure Rcheck_PE_Potentially_Blocking_Operation (File : System.Address; Line : Integer); + procedure Rcheck_PE_Stream_Operation_Not_Allowed + (File : System.Address; Line : Integer); procedure Rcheck_PE_Stubbed_Subprogram_Called (File : System.Address; Line : Integer); procedure Rcheck_PE_Unchecked_Union_Restriction (File : System.Address; Line : Integer); - procedure Rcheck_PE_Non_Transportable_Actual - (File : System.Address; Line : Integer); procedure Rcheck_SE_Empty_Storage_Pool (File : System.Address; Line : Integer); procedure Rcheck_SE_Explicit_Raise @@ -545,16 +547,18 @@ package body Ada.Exceptions is "__gnat_rcheck_PE_Misaligned_Address_Value"); pragma Export (C, Rcheck_PE_Missing_Return, "__gnat_rcheck_PE_Missing_Return"); + pragma Export (C, Rcheck_PE_Non_Transportable_Actual, + "__gnat_rcheck_PE_Non_Transportable_Actual"); pragma Export (C, Rcheck_PE_Overlaid_Controlled_Object, "__gnat_rcheck_PE_Overlaid_Controlled_Object"); pragma Export (C, Rcheck_PE_Potentially_Blocking_Operation, "__gnat_rcheck_PE_Potentially_Blocking_Operation"); + pragma Export (C, Rcheck_PE_Stream_Operation_Not_Allowed, + "__gnat_rcheck_PE_Stream_Operation_Not_Allowed"); pragma Export (C, Rcheck_PE_Stubbed_Subprogram_Called, "__gnat_rcheck_PE_Stubbed_Subprogram_Called"); pragma Export (C, Rcheck_PE_Unchecked_Union_Restriction, "__gnat_rcheck_PE_Unchecked_Union_Restriction"); - pragma Export (C, Rcheck_PE_Non_Transportable_Actual, - "__gnat_rcheck_PE_Non_Transportable_Actual"); pragma Export (C, Rcheck_SE_Empty_Storage_Pool, "__gnat_rcheck_SE_Empty_Storage_Pool"); pragma Export (C, Rcheck_SE_Explicit_Raise, @@ -603,11 +607,12 @@ package body Ada.Exceptions is pragma No_Return (Rcheck_PE_Implicit_Return); pragma No_Return (Rcheck_PE_Misaligned_Address_Value); pragma No_Return (Rcheck_PE_Missing_Return); + pragma No_Return (Rcheck_PE_Non_Transportable_Actual); pragma No_Return (Rcheck_PE_Overlaid_Controlled_Object); pragma No_Return (Rcheck_PE_Potentially_Blocking_Operation); + pragma No_Return (Rcheck_PE_Stream_Operation_Not_Allowed); pragma No_Return (Rcheck_PE_Stubbed_Subprogram_Called); pragma No_Return (Rcheck_PE_Unchecked_Union_Restriction); - pragma No_Return (Rcheck_PE_Non_Transportable_Actual); pragma No_Return (Rcheck_PE_Finalize_Raised_Exception); pragma No_Return (Rcheck_SE_Empty_Storage_Pool); pragma No_Return (Rcheck_SE_Explicit_Raise); @@ -668,6 +673,7 @@ package body Ada.Exceptions is Rmsg_33 : constant String := "explicit raise" & NUL; Rmsg_34 : constant String := "infinite recursion" & NUL; Rmsg_35 : constant String := "object too large" & NUL; + Rmsg_36 : constant String := "stream operation not allowed" & NUL; ----------------------- -- Polling Interface -- @@ -1392,6 +1398,13 @@ package body Ada.Exceptions is Raise_Program_Error_Msg (File, Line, Rmsg_26'Address); end Rcheck_PE_Missing_Return; + procedure Rcheck_PE_Non_Transportable_Actual + (File : System.Address; Line : Integer) + is + begin + Raise_Program_Error_Msg (File, Line, Rmsg_31'Address); + end Rcheck_PE_Non_Transportable_Actual; + procedure Rcheck_PE_Overlaid_Controlled_Object (File : System.Address; Line : Integer) is @@ -1406,6 +1419,13 @@ package body Ada.Exceptions is Raise_Program_Error_Msg (File, Line, Rmsg_28'Address); end Rcheck_PE_Potentially_Blocking_Operation; + procedure Rcheck_PE_Stream_Operation_Not_Allowed + (File : System.Address; Line : Integer) + is + begin + Raise_Program_Error_Msg (File, Line, Rmsg_36'Address); + end Rcheck_PE_Stream_Operation_Not_Allowed; + procedure Rcheck_PE_Stubbed_Subprogram_Called (File : System.Address; Line : Integer) is @@ -1420,13 +1440,6 @@ package body Ada.Exceptions is Raise_Program_Error_Msg (File, Line, Rmsg_30'Address); end Rcheck_PE_Unchecked_Union_Restriction; - procedure Rcheck_PE_Non_Transportable_Actual - (File : System.Address; Line : Integer) - is - begin - Raise_Program_Error_Msg (File, Line, Rmsg_31'Address); - end Rcheck_PE_Non_Transportable_Actual; - procedure Rcheck_SE_Empty_Storage_Pool (File : System.Address; Line : Integer) is diff --git a/gcc/ada/a-except.adb b/gcc/ada/a-except.adb index 9e4b1e8e4ce..61632046972 100644 --- a/gcc/ada/a-except.adb +++ b/gcc/ada/a-except.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, 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- -- @@ -412,16 +412,18 @@ package body Ada.Exceptions is (File : System.Address; Line : Integer); procedure Rcheck_PE_Missing_Return (File : System.Address; Line : Integer); + procedure Rcheck_PE_Non_Transportable_Actual + (File : System.Address; Line : Integer); procedure Rcheck_PE_Overlaid_Controlled_Object (File : System.Address; Line : Integer); procedure Rcheck_PE_Potentially_Blocking_Operation (File : System.Address; Line : Integer); + procedure Rcheck_PE_Stream_Operation_Not_Allowed + (File : System.Address; Line : Integer); procedure Rcheck_PE_Stubbed_Subprogram_Called (File : System.Address; Line : Integer); procedure Rcheck_PE_Unchecked_Union_Restriction (File : System.Address; Line : Integer); - procedure Rcheck_PE_Non_Transportable_Actual - (File : System.Address; Line : Integer); procedure Rcheck_SE_Empty_Storage_Pool (File : System.Address; Line : Integer); procedure Rcheck_SE_Explicit_Raise @@ -492,16 +494,18 @@ package body Ada.Exceptions is "__gnat_rcheck_PE_Misaligned_Address_Value"); pragma Export (C, Rcheck_PE_Missing_Return, "__gnat_rcheck_PE_Missing_Return"); + pragma Export (C, Rcheck_PE_Non_Transportable_Actual, + "__gnat_rcheck_PE_Non_Transportable_Actual"); pragma Export (C, Rcheck_PE_Overlaid_Controlled_Object, "__gnat_rcheck_PE_Overlaid_Controlled_Object"); pragma Export (C, Rcheck_PE_Potentially_Blocking_Operation, "__gnat_rcheck_PE_Potentially_Blocking_Operation"); + pragma Export (C, Rcheck_PE_Stream_Operation_Not_Allowed, + "__gnat_rcheck_PE_Stream_Operation_Not_Allowed"); pragma Export (C, Rcheck_PE_Stubbed_Subprogram_Called, "__gnat_rcheck_PE_Stubbed_Subprogram_Called"); pragma Export (C, Rcheck_PE_Unchecked_Union_Restriction, "__gnat_rcheck_PE_Unchecked_Union_Restriction"); - pragma Export (C, Rcheck_PE_Non_Transportable_Actual, - "__gnat_rcheck_PE_Non_Transportable_Actual"); pragma Export (C, Rcheck_SE_Empty_Storage_Pool, "__gnat_rcheck_SE_Empty_Storage_Pool"); pragma Export (C, Rcheck_SE_Explicit_Raise, @@ -542,10 +546,11 @@ package body Ada.Exceptions is pragma No_Return (Rcheck_PE_Misaligned_Address_Value); pragma No_Return (Rcheck_PE_Missing_Return); pragma No_Return (Rcheck_PE_Overlaid_Controlled_Object); + pragma No_Return (Rcheck_PE_Non_Transportable_Actual); pragma No_Return (Rcheck_PE_Potentially_Blocking_Operation); + pragma No_Return (Rcheck_PE_Stream_Operation_Not_Allowed); pragma No_Return (Rcheck_PE_Stubbed_Subprogram_Called); pragma No_Return (Rcheck_PE_Unchecked_Union_Restriction); - pragma No_Return (Rcheck_PE_Non_Transportable_Actual); pragma No_Return (Rcheck_PE_Finalize_Raised_Exception); pragma No_Return (Rcheck_SE_Empty_Storage_Pool); pragma No_Return (Rcheck_SE_Explicit_Raise); @@ -576,6 +581,7 @@ package body Ada.Exceptions is procedure Rcheck_19 (File : System.Address; Line : Integer); procedure Rcheck_20 (File : System.Address; Line : Integer); procedure Rcheck_21 (File : System.Address; Line : Integer); + procedure Rcheck_22 (File : System.Address; Line : Integer); procedure Rcheck_23 (File : System.Address; Line : Integer); procedure Rcheck_24 (File : System.Address; Line : Integer); procedure Rcheck_25 (File : System.Address; Line : Integer); @@ -589,8 +595,7 @@ package body Ada.Exceptions is procedure Rcheck_33 (File : System.Address; Line : Integer); procedure Rcheck_34 (File : System.Address; Line : Integer); procedure Rcheck_35 (File : System.Address; Line : Integer); - - procedure Rcheck_22 (File : System.Address; Line : Integer); + procedure Rcheck_36 (File : System.Address; Line : Integer); pragma Export (C, Rcheck_00, "__gnat_rcheck_00"); pragma Export (C, Rcheck_01, "__gnat_rcheck_01"); @@ -628,6 +633,7 @@ package body Ada.Exceptions is pragma Export (C, Rcheck_33, "__gnat_rcheck_33"); pragma Export (C, Rcheck_34, "__gnat_rcheck_34"); pragma Export (C, Rcheck_35, "__gnat_rcheck_35"); + pragma Export (C, Rcheck_36, "__gnat_rcheck_36"); -- None of these procedures ever returns (they raise an exception). By -- using pragma No_Return, we ensure that any junk code after the call, @@ -668,6 +674,7 @@ package body Ada.Exceptions is pragma No_Return (Rcheck_33); pragma No_Return (Rcheck_34); pragma No_Return (Rcheck_35); + pragma No_Return (Rcheck_36); --------------------------------------------- -- Reason Strings for Run-Time Check Calls -- @@ -718,6 +725,7 @@ package body Ada.Exceptions is Rmsg_33 : constant String := "explicit raise" & NUL; Rmsg_34 : constant String := "infinite recursion" & NUL; Rmsg_35 : constant String := "object too large" & NUL; + Rmsg_36 : constant String := "stream operation not allowed" & NUL; ----------------------- -- Polling Interface -- @@ -1357,6 +1365,13 @@ package body Ada.Exceptions is Raise_Program_Error_Msg (File, Line, Rmsg_26'Address); end Rcheck_PE_Missing_Return; + procedure Rcheck_PE_Non_Transportable_Actual + (File : System.Address; Line : Integer) + is + begin + Raise_Program_Error_Msg (File, Line, Rmsg_31'Address); + end Rcheck_PE_Non_Transportable_Actual; + procedure Rcheck_PE_Overlaid_Controlled_Object (File : System.Address; Line : Integer) is @@ -1371,6 +1386,13 @@ package body Ada.Exceptions is Raise_Program_Error_Msg (File, Line, Rmsg_28'Address); end Rcheck_PE_Potentially_Blocking_Operation; + procedure Rcheck_PE_Stream_Operation_Not_Allowed + (File : System.Address; Line : Integer) + is + begin + Raise_Program_Error_Msg (File, Line, Rmsg_36'Address); + end Rcheck_PE_Stream_Operation_Not_Allowed; + procedure Rcheck_PE_Stubbed_Subprogram_Called (File : System.Address; Line : Integer) is @@ -1385,13 +1407,6 @@ package body Ada.Exceptions is Raise_Program_Error_Msg (File, Line, Rmsg_30'Address); end Rcheck_PE_Unchecked_Union_Restriction; - procedure Rcheck_PE_Non_Transportable_Actual - (File : System.Address; Line : Integer) - is - begin - Raise_Program_Error_Msg (File, Line, Rmsg_31'Address); - end Rcheck_PE_Non_Transportable_Actual; - procedure Rcheck_SE_Empty_Storage_Pool (File : System.Address; Line : Integer) is @@ -1483,6 +1498,8 @@ package body Ada.Exceptions is renames Rcheck_PE_Duplicated_Entry_Address; procedure Rcheck_22 (File : System.Address; Line : Integer) renames Rcheck_PE_Explicit_Raise; + procedure Rcheck_23 (File : System.Address; Line : Integer) + renames Rcheck_PE_Finalize_Raised_Exception; procedure Rcheck_24 (File : System.Address; Line : Integer) renames Rcheck_PE_Implicit_Return; procedure Rcheck_25 (File : System.Address; Line : Integer) @@ -1507,9 +1524,8 @@ package body Ada.Exceptions is renames Rcheck_SE_Infinite_Recursion; procedure Rcheck_35 (File : System.Address; Line : Integer) renames Rcheck_SE_Object_Too_Large; - - procedure Rcheck_23 (File : System.Address; Line : Integer) - renames Rcheck_PE_Finalize_Raised_Exception; + procedure Rcheck_36 (File : System.Address; Line : Integer) + renames Rcheck_PE_Stream_Operation_Not_Allowed; ------------- -- Reraise -- diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index e96f4320e28..b24c3d14720 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -3246,13 +3246,10 @@ package body Exp_Attr is -- container). In that case rewrite the attribute as a Raise to -- prevent any run-time use. - -- This is not an explicit raise, the Reason code is wrong, we most - -- likely need a new Reason code ??? - if Restriction_Active (No_Streams) then Rewrite (N, Make_Raise_Program_Error (Sloc (N), - Reason => PE_Explicit_Raise)); + Reason => PE_Stream_Operation_Not_Allowed)); Set_Etype (N, B_Type); return; end if; @@ -4248,7 +4245,7 @@ package body Exp_Attr is if Restriction_Active (No_Streams) then Rewrite (N, Make_Raise_Program_Error (Sloc (N), - Reason => PE_Explicit_Raise)); + Reason => PE_Stream_Operation_Not_Allowed)); Set_Etype (N, Standard_Void_Type); return; end if; @@ -4888,7 +4885,7 @@ package body Exp_Attr is if Restriction_Active (No_Streams) then Rewrite (N, Make_Raise_Program_Error (Sloc (N), - Reason => PE_Explicit_Raise)); + Reason => PE_Stream_Operation_Not_Allowed)); Set_Etype (N, B_Type); return; end if; @@ -6600,7 +6597,7 @@ package body Exp_Attr is if Restriction_Active (No_Streams) then Rewrite (N, Make_Raise_Program_Error (Sloc (N), - Reason => PE_Explicit_Raise)); + Reason => PE_Stream_Operation_Not_Allowed)); Set_Etype (N, U_Type); return; end if; diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 1a27245d09c..e9e1232afa5 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -2137,16 +2137,18 @@ package body Exp_Ch11 is Add_Str_To_Name_Buffer ("PE_Misaligned_Address_Value"); when PE_Missing_Return => Add_Str_To_Name_Buffer ("PE_Missing_Return"); + when PE_Non_Transportable_Actual => + Add_Str_To_Name_Buffer ("PE_Non_Transportable_Actual"); when PE_Overlaid_Controlled_Object => Add_Str_To_Name_Buffer ("PE_Overlaid_Controlled_Object"); when PE_Potentially_Blocking_Operation => Add_Str_To_Name_Buffer ("PE_Potentially_Blocking_Operation"); + when PE_Stream_Operation_Not_Allowed => + Add_Str_To_Name_Buffer ("PE_Stream_Operation_Not_Allowed"); when PE_Stubbed_Subprogram_Called => Add_Str_To_Name_Buffer ("PE_Stubbed_Subprogram_Called"); when PE_Unchecked_Union_Restriction => Add_Str_To_Name_Buffer ("PE_Unchecked_Union_Restriction"); - when PE_Non_Transportable_Actual => - Add_Str_To_Name_Buffer ("PE_Non_Transportable_Actual"); when SE_Empty_Storage_Pool => Add_Str_To_Name_Buffer ("SE_Empty_Storage_Pool"); diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index c794f7d057a..1abda22085d 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -2399,6 +2399,9 @@ package body Exp_Ch7 is Stmt : Node_Id; Stmt_2 : Node_Id; + Deep_Init_Found : Boolean := False; + -- A flag set when a call to [Deep_]Initialize has been found + -- Start of processing for Find_Last_Init begin @@ -2488,19 +2491,22 @@ package body Exp_Ch7 is Call := Find_Last_Init_In_Block (Stmt_2); if Present (Call) then - Last_Init := Call; - Body_Insert := Stmt_2; + Deep_Init_Found := True; + Last_Init := Call; + Body_Insert := Stmt_2; end if; elsif Is_Init_Call (Stmt_2) then - Last_Init := Stmt_2; - Body_Insert := Last_Init; + Deep_Init_Found := True; + Last_Init := Stmt_2; + Body_Insert := Last_Init; end if; + end if; -- If the object lacks a call to Deep_Initialize, then it must -- have a call to its related type init proc. - elsif Is_Init_Call (Stmt) then + if not Deep_Init_Found and then Is_Init_Call (Stmt) then Last_Init := Stmt; Body_Insert := Last_Init; end if; diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb index 7337acc7c97..e184cb6a263 100644 --- a/gcc/ada/exp_dbug.adb +++ b/gcc/ada/exp_dbug.adb @@ -1103,7 +1103,8 @@ package body Exp_Dbug is function Qualify_Needed (S : Entity_Id) return Boolean; -- Given a scope, determines if the scope is to be included in the - -- fully qualified name, True if so, False if not. + -- fully qualified name, True if so, False if not. Blocks and loops + -- are excluded from a qualified name. procedure Set_BNPE_Suffix (E : Entity_Id); -- Recursive routine to append the BNPE qualification suffix. Works @@ -1218,6 +1219,7 @@ package body Exp_Dbug is return Is_Subprogram (Ent) or else Ekind (Ent) = E_Subprogram_Body or else (Ekind (S) /= E_Block + and then Ekind (S) /= E_Loop and then not Is_Dynamic_Scope (S)); end if; end Qualify_Needed; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 0b6d7a3e628..6f8ad43843f 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -4556,17 +4556,6 @@ package body Exp_Util is -- Start of processing for Is_Aliased begin - -- 'Reference-d or renamed transient objects are not consider aliased - -- when the related context is a Boolean expression_with_actions. The - -- Boolean result is always known after the action list is evaluated, - -- therefore the transient objects must be finalized at that point. - - if Nkind (Rel_Node) = N_Expression_With_Actions - and then Is_Boolean_Type (Etype (Rel_Node)) - then - return False; - end if; - Stmt := First_Stmt; while Present (Stmt) loop if Nkind (Stmt) = N_Object_Declaration then diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi index e23f9fadd83..d66ed9affbd 100644 --- a/gcc/ada/projects.texi +++ b/gcc/ada/projects.texi @@ -1,7 +1,7 @@ @set gprconfig GPRconfig @c ------ projects.texi -@c Copyright (C) 2002-2013, Free Software Foundation, Inc. +@c Copyright (C) 2002-2014, Free Software Foundation, Inc. @c This file is shared between the GNAT user's guide and gprbuild. It is not @c compilable on its own, you should instead compile the other two manuals. @c For that reason, there is no toplevel @menu @@ -2465,7 +2465,7 @@ use a project file like: @smallexample @c projectfile aggregate project Agg is - for Project_Path use (external("SETUP") % "path"); + for Project_Path use (external("SETUP") & "path"); for Project_Files use ("myproject.gpr"); end Agg; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index d22118e4db8..0495c7c9668 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -412,8 +412,7 @@ package body Sem_Attr is procedure Uneval_Old_Msg; -- Called when Loop_Entry or Old is used in a potentially unevaluated -- expression. Generates appropriate message or warning depending on - -- the setting of Opt.Uneval_Old. The caller has put the Name_Id of - -- the attribute in Error_Msg_Name_1 prior to the call. + -- the setting of Opt.Uneval_Old. procedure Unexpected_Argument (En : Node_Id); -- Signal unexpected attribute argument (En is the argument) @@ -2284,9 +2283,10 @@ package body Sem_Attr is & "unevaluated must denote an entity"); when 'W' => - Error_Attr_P + Error_Msg_Name_1 := Aname; + Error_Msg_F ("??prefix of attribute % appears in potentially " - & "unevaluated context, exception may be raised"); + & "unevaluated context, exception may be raised", P); when 'A' => null; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 265c2c7adc6..3ac6e6b42d9 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -3182,16 +3182,20 @@ package body Sem_Ch5 is -- unreachable code, since it is useless and we don't -- want to generate junk warnings. - -- We skip this step if we are not in code generation mode. + -- We skip this step if we are not in code generation mode + -- or CodePeer mode. -- This is the one case where we remove dead code in the -- semantics as opposed to the expander, and we do not want -- to remove code if we are not in code generation mode, - -- since this messes up the ASIS trees. + -- since this messes up the ASIS trees or loses useful + -- information in the CodePeer tree. -- Note that one might react by moving the whole circuit to -- exp_ch5, but then we lose the warning in -gnatc mode. - if Operating_Mode = Generate_Code then + if Operating_Mode = Generate_Code + and then not CodePeer_Mode + then loop Nxt := Next (N); diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads index 46fb714ee57..c54097b2c48 100644 --- a/gcc/ada/types.ads +++ b/gcc/ada/types.ads @@ -823,12 +823,16 @@ package Types is -- 1. Modify the type and subtype declarations below appropriately, -- keeping things in alphabetical order. - -- 2. Modify the corresponding definitions in types.h, including the + -- 2. Assign a new number to the reason. Do not renumber existing codes, + -- this causes compatibility/bootstrap issues. So always add the new + -- code at the end of the existing range. + + -- 3. Modify the corresponding definitions in types.h, including the -- definition of last_reason_code. - -- 3. Add the name of the routines in exp_ch11.Get_RT_Exception_Name + -- 4. Add the name of the routines in exp_ch11.Get_RT_Exception_Name - -- 4. Add a new routine in Ada.Exceptions with the appropriate call and + -- 5. Add a new routine in Ada.Exceptions with the appropriate call and -- static string constant. Note that there is more than one version -- of a-except.adb which must be modified. @@ -861,24 +865,28 @@ package Types is PE_Implicit_Return, -- 24 PE_Misaligned_Address_Value, -- 25 PE_Missing_Return, -- 26 + PE_Non_Transportable_Actual, -- 31 PE_Overlaid_Controlled_Object, -- 27 PE_Potentially_Blocking_Operation, -- 28 + PE_Stream_Operation_Not_Allowed, -- 36 PE_Stubbed_Subprogram_Called, -- 29 PE_Unchecked_Union_Restriction, -- 30 - PE_Non_Transportable_Actual, -- 31 SE_Empty_Storage_Pool, -- 32 SE_Explicit_Raise, -- 33 SE_Infinite_Recursion, -- 34 SE_Object_Too_Large); -- 35 + Last_Reason_Code : constant := 36; + -- Last reason code + subtype RT_CE_Exceptions is RT_Exception_Code range CE_Access_Check_Failed .. CE_Tag_Check_Failed; subtype RT_PE_Exceptions is RT_Exception_Code range PE_Access_Before_Elaboration .. - PE_Non_Transportable_Actual; + PE_Unchecked_Union_Restriction; subtype RT_SE_Exceptions is RT_Exception_Code range SE_Empty_Storage_Pool .. diff --git a/gcc/ada/types.h b/gcc/ada/types.h index dc3f82fec31..949065c2c80 100644 --- a/gcc/ada/types.h +++ b/gcc/ada/types.h @@ -383,15 +383,16 @@ typedef Int Mechanism_Type; #define PE_Implicit_Return 24 #define PE_Misaligned_Address_Value 25 #define PE_Missing_Return 26 +#define PE_Non_Transportable_Actual 31 #define PE_Overlaid_Controlled_Object 27 #define PE_Potentially_Blocking_Operation 28 +#define PE_Stream_Operation_Not_Allowed 36 #define PE_Stubbed_Subprogram_Called 29 #define PE_Unchecked_Union_Restriction 30 -#define PE_Non_Transportable_Actual 31 #define SE_Empty_Storage_Pool 32 #define SE_Explicit_Raise 33 #define SE_Infinite_Recursion 34 #define SE_Object_Too_Large 35 -#define LAST_REASON_CODE 35 +#define LAST_REASON_CODE 36 |