diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 48 | ||||
| -rw-r--r-- | gcc/ada/atree.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/atree.ads | 13 | ||||
| -rw-r--r-- | gcc/ada/debug.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/einfo.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/exp_attr.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/gnat1drv.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/opt.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/par-ch4.adb | 21 | ||||
| -rw-r--r-- | gcc/ada/scng.adb | 67 | ||||
| -rw-r--r-- | gcc/ada/sem.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/sem.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.ads | 9 | ||||
| -rw-r--r-- | gcc/ada/sem_ch10.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_elab.adb | 78 | ||||
| -rw-r--r-- | gcc/ada/snames.ads-tmpl | 2 | ||||
| -rw-r--r-- | gcc/ada/switch-c.adb | 6 |
20 files changed, 261 insertions, 78 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 28c47b8e76e..5a6aa8c5d1d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,53 @@ 2012-03-19 Yannick Moy <moy@adacore.com> + * sem_ch6.adb: Minor code clean up. + +2012-03-19 Vincent Celier <celier@adacore.com> + + * make.adb (Scan_Make_Arg): Make sure all significant -m switches + on the command line are counted. + +2012-03-19 Robert Dewar <dewar@adacore.com> + + * sem_elab.adb (Generate_Elab_Warnings): Fix spec, fix attribute + reference case + +2012-03-19 Robert Dewar <dewar@adacore.com> + + * par-ch4.adb (Check_Bad_Exp): New procedure + +2012-03-19 Robert Dewar <dewar@adacore.com> + + * exp_attr.adb, sem_attr.adb, sem_attr.ads, snames.ads-tmpl: Add + initial framework for Valid_Scalars attribute. + +2012-03-19 Robert Dewar <dewar@adacore.com> + + * scng.adb (Scan): Recognize incorrect preprocessor directive + +2012-03-19 Robert Dewar <dewar@adacore.com> + + * atree.adb (Allocate_Initialize_Node): Use Num_Extension_Nodes + * atree.ads (Num_Extension_Nodes): New variable + * debug.adb: New debug flag -gnatd.N + * gnat1drv.adb (Adjust_Global_Switches): Adjust + Num_Extension_Nodes if -gnatd.N set + +2012-03-19 Eric Botcazou <ebotcazou@adacore.com> + + * einfo.ads: Minor update to First_Rep_Item and Has_Gigi_Rep_Item + descriptions. + +2012-03-19 Robert Dewar <dewar@adacore.com> + + * opt.ads: Remove HLO_Active flag. + * sem.adb: Remove call of high level optimizer. + * sem.ads (New_Nodes_OK): Removed. + * sem_ch10.adb: Remove references to New_Nodes_OK. + * switch-c.adb: Remove handling of -gnatH switch. + +2012-03-19 Yannick Moy <moy@adacore.com> + * sem_ch6.adb (Check_Subprogram_Contract): Do not emit warnings on trivially True or False postconditions and Ensures components of contract-cases. diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 793da138861..dce76e9db41 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -516,11 +516,11 @@ package body Atree is if With_Extension then if Present (Src) and then Has_Extension (Src) then - for J in 1 .. 4 loop + for J in 1 .. Num_Extension_Nodes loop Nodes.Append (Nodes.Table (Src + Node_Id (J))); end loop; else - for J in 1 .. 4 loop + for J in 1 .. Num_Extension_Nodes loop Nodes.Append (Default_Node_Extension); end loop; end if; diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index 305e914f97c..c0568ba5c77 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -65,6 +65,17 @@ package Atree is -- syntax tree format. Subsequent processing in the front end traverses the -- tree, transforming it in various ways and adding semantic information. + ---------------------- + -- Size of Entities -- + ---------------------- + + -- Currently entities are composed of 5 sequentially allocated 32-byte + -- nodes, considered as a single record. The following definition gives + -- the number of extension nodes. + + Num_Extension_Nodes : Int := 4; + -- This value is increased by one if debug flag -gnatd.N is set + ---------------------------------------- -- Definitions of Fields in Tree Node -- ---------------------------------------- diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 032ba9dfe1e..bb3e4857ad5 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -131,7 +131,7 @@ package body Debug is -- d.K Alfa detection only mode for gnat2why -- d.L Depend on back end for limited types in conditional expressions -- d.M - -- d.N + -- d.N Add node to all entities -- d.O Dump internal SCO tables -- d.P Previous (non-optimized) handling of length comparisons -- d.Q @@ -629,6 +629,10 @@ package body Debug is -- case expansion, leaving it up to the back end to handle conditional -- expressions correctly. + -- d.N Enlarge entities by one node (but don't attempt to use this extra + -- node for storage of any flags or fields). This can be used to do + -- experiments on the impact of increasing entity sizes. + -- d.O Dump internal SCO tables. Before outputting the SCO information to -- the ALI file, the internal SCO tables (SCO_Table/SCO_Unit_Table) -- are dumped for debugging purposes. diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index c6cf78a543c..cf5aebe7311 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1277,11 +1277,13 @@ package Einfo is -- reflect the specified information. However, there are some items that -- are only reflected in the chain. These include: -- --- Alignment attribute definition clause -- Machine_Attribute pragma -- Link_Alias pragma -- Linker_Section pragma +-- Linker_Constructor pragma +-- Linker_Destructor pragma -- Weak_External pragma +-- Thread_Local_Storage pragma -- -- If any of these items are present, then the flag Has_Gigi_Rep_Item is -- set, indicating that Gigi should search the chain. @@ -1530,6 +1532,7 @@ package Einfo is -- Linker_Constructor pragma -- Linker_Destructor pragma -- Weak_External pragma +-- Thread_Local_Storage pragma -- -- If this flag is set, then Gigi should scan the rep item chain to -- process any of these items that appear. At least one such item will diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 5843df9b851..b8058ae2442 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -5368,6 +5368,15 @@ package body Exp_Attr is Validity_Checks_On := Save_Validity_Checks_On; end Valid; + ------------------- + -- Valid_Scalars -- + ------------------- + + when Attribute_Valid_Scalars => Valid_Scalars : declare + begin + raise Program_Error; + end Valid_Scalars; + ----------- -- Value -- ----------- diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 7d96468e5f4..783babda056 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -289,6 +289,12 @@ procedure Gnat1drv is Ttypes.Target_Strict_Alignment := True; end if; + -- Increase size of allocated entities if debug flag -gnatd.N is set + + if Debug_Flag_Dot_NN then + Atree.Num_Extension_Nodes := Atree.Num_Extension_Nodes + 1; + end if; + -- Disable static allocation of dispatch tables if -gnatd.t or if layout -- is enabled. The front end's layout phase currently treats types that -- have discriminant-dependent arrays as not being static even when a diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index e2512a0678c..e43495bd238 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -7423,6 +7423,16 @@ package body Make is Add_Switch (Argv, Program_Args, And_Save => And_Save); + -- Make sure that all significant switches -m on the command line + -- are counted. + + if Argv'Length > 2 + and then Argv (1 .. 2) = "-m" + and then Argv /= "-mieee" + then + N_M_Switch := N_M_Switch + 1; + end if; + -- Handle non-default compiler, binder, linker, and handle --RTS switch elsif Argv'Length > 2 and then Argv (1 .. 2) = "--" then diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 5fcd0bf3119..a1dc37cf51c 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -666,10 +666,6 @@ package Opt is -- Heap size for memory allocations. Valid values are 32 and 64. Only -- available on VMS. - HLO_Active : Boolean := False; - -- GNAT - -- True if High Level Optimizer is activated (-gnatH switch) - Identifier_Character_Set : Character; -- GNAT -- This variable indicates the character set to be used for identifiers. diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index 59884d24c73..79aa85fad2d 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -81,6 +81,9 @@ package body Ch4 is -- Called to place complaint about bad range attribute at the given -- source location. Terminates by raising Error_Resync. + procedure Check_Bad_Exp; + -- Called after scanning a**b, posts error if ** detected + procedure P_Membership_Test (N : Node_Id); -- N is the node for a N_In or N_Not_In node whose right operand has not -- yet been processed. It is called just after scanning out the IN keyword. @@ -107,6 +110,20 @@ package body Ch4 is Resync_Expression; end Bad_Range_Attribute; + ------------------- + -- Check_Bad_Exp -- + ------------------- + + procedure Check_Bad_Exp is + begin + if Token = Tok_Double_Asterisk then + Error_Msg_SC ("parenthesization required for '*'*"); + Scan; -- past ** + Discard_Junk_Node (P_Primary); + Check_Bad_Exp; + end if; + end Check_Bad_Exp; + -------------------------- -- 4.1 Name (also 6.4) -- -------------------------- @@ -1933,6 +1950,7 @@ package body Ch4 is Scan; -- past ** Set_Left_Opnd (Node2, Node1); Set_Right_Opnd (Node2, P_Primary); + Check_Bad_Exp; Node1 := Node2; end if; @@ -2320,6 +2338,7 @@ package body Ch4 is Scan; -- past ** Set_Left_Opnd (Node2, Node1); Set_Right_Opnd (Node2, P_Primary); + Check_Bad_Exp; return Node2; else return Node1; diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb index 2935bdbe6fb..b0a17db28b9 100644 --- a/gcc/ada/scng.adb +++ b/gcc/ada/scng.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -2242,6 +2242,71 @@ package body Scng is Scan_Ptr := Scan_Ptr + 1; return; + -- Check for something looking like a preprocessor directive + + elsif Source (Scan_Ptr) = '#' + and then (Source (Scan_Ptr + 1 .. Scan_Ptr + 2) = "if" + or else + Source (Scan_Ptr + 1 .. Scan_Ptr + 5) = "elsif" + or else + Source (Scan_Ptr + 1 .. Scan_Ptr + 4) = "else" + or else + Source (Scan_Ptr + 1 .. Scan_Ptr + 3) = "end") + then + Error_Msg_S + ("preprocessor directive ignored, preprocessor not active"); + + -- Skip to end of line + + loop + if Source (Scan_Ptr) in Graphic_Character + or else + Source (Scan_Ptr) = HT + then + Scan_Ptr := Scan_Ptr + 1; + + -- Done if line terminator or EOF + + elsif Source (Scan_Ptr) in Line_Terminator + or else + Source (Scan_Ptr) = EOF + then + exit; + + -- If we have a wide character, we have to scan it out, + -- because it might be a legitimate line terminator + + elsif Start_Of_Wide_Character then + declare + Wptr : constant Source_Ptr := Scan_Ptr; + Code : Char_Code; + Err : Boolean; + + begin + Scan_Wide (Source, Scan_Ptr, Code, Err); + + -- If not well formed wide character, then just skip + -- past it and ignore it. + + if Err then + Scan_Ptr := Wptr + 1; + + -- If UTF_32 terminator, terminate comment scan + + elsif Is_UTF_32_Line_Terminator (UTF_32 (Code)) then + Scan_Ptr := Wptr; + exit; + end if; + end; + + -- Else keep going (don't worry about bad comment chars + -- in this context, we just want to find the end of line. + + else + Scan_Ptr := Scan_Ptr + 1; + end if; + end loop; + -- Otherwise, this is an illegal character else diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 6966f45a8e9..2e50d3dc73b 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -30,7 +30,6 @@ with Elists; use Elists; with Errout; use Errout; with Expander; use Expander; with Fname; use Fname; -with HLO; use HLO; with Lib; use Lib; with Lib.Load; use Lib.Load; with Nlists; use Nlists; @@ -1367,7 +1366,6 @@ package body Sem is S_Global_Dis_Names : constant Boolean := Global_Discard_Names; S_In_Spec_Expr : constant Boolean := In_Spec_Expression; S_Inside_A_Generic : constant Boolean := Inside_A_Generic; - S_New_Nodes_OK : constant Int := New_Nodes_OK; S_Outer_Gen_Scope : constant Entity_Id := Outer_Generic_Scope; Generic_Main : constant Boolean := @@ -1386,8 +1384,7 @@ package body Sem is -- and we need to restore these saved values at the end. procedure Do_Analyze; - -- Procedure to analyze the compilation unit. This is called more than - -- once when the high level optimizer is activated. + -- Procedure to analyze the compilation unit ---------------- -- Do_Analyze -- @@ -1491,15 +1488,6 @@ package body Sem is if not Analyzed (Comp_Unit) then Initialize_Version (Current_Sem_Unit); - if HLO_Active then - Expander_Mode_Save_And_Set (False); - New_Nodes_OK := 1; - Do_Analyze; - Reset_Analyzed_Flags (Comp_Unit); - Expander_Mode_Restore; - High_Level_Optimize (Comp_Unit); - New_Nodes_OK := 0; - end if; -- Do analysis, and then append the compilation unit onto the -- Comp_Unit_List, if appropriate. This is done after analysis, @@ -1547,7 +1535,6 @@ package body Sem is GNAT_Mode := S_GNAT_Mode; In_Spec_Expression := S_In_Spec_Expr; Inside_A_Generic := S_Inside_A_Generic; - New_Nodes_OK := S_New_Nodes_OK; Outer_Generic_Scope := S_Outer_Gen_Scope; Restore_Opt_Config_Switches (Save_Config_Switches); diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads index 3fa25f90f97..00babf3b371 100644 --- a/gcc/ada/sem.ads +++ b/gcc/ada/sem.ads @@ -209,10 +209,6 @@ with Types; use Types; package Sem is - New_Nodes_OK : Int := 1; - -- Temporary flag for use in checking out HLO. Set non-zero if it is - -- OK to generate new nodes. - ----------------------------- -- Semantic Analysis Flags -- ----------------------------- diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 084e621dad7..77db15ed21e 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -5196,6 +5196,15 @@ package body Sem_Attr is Set_Etype (N, Standard_Boolean); + ------------------- + -- Valid_Scalars -- + ------------------- + + when Attribute_Valid_Scalars => + Check_E0; + Check_Type; + -- More stuff TBD ??? + ----------- -- Value -- ----------- @@ -6034,7 +6043,7 @@ package body Sem_Attr is return; -- No other cases are foldable (they certainly aren't static, and at - -- the moment we don't try to fold any cases other than these three). + -- the moment we don't try to fold any cases other than the ones above). else Check_Expressions; @@ -8145,6 +8154,7 @@ package body Sem_Attr is Attribute_Universal_Literal_String | Attribute_Unrestricted_Access | Attribute_Valid | + Attribute_Valid_Scalars | Attribute_Value | Attribute_Wchar_T_Size | Attribute_Wide_Value | diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads index a12d5a70a9e..25e6adf3519 100644 --- a/gcc/ada/sem_attr.ads +++ b/gcc/ada/sem_attr.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -549,6 +549,13 @@ package Sem_Attr is -- Natural'Size is typically 31, the value of Natural'VADS_Size is 32. -- For all other types, Size and VADS_Size yield the same value. + ------------------- + -- Valid_Scalars -- + ------------------- + + Attribute_Valid_Scalars => True, + -- Typ'Valid_Scalars applies to ??? + ---------------- -- Value_Size -- ---------------- diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 1aa25c2a542..64e7e322026 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -2977,7 +2977,6 @@ package body Sem_Ch10 is -- Start of processing for Expand_With_Clause begin - New_Nodes_OK := New_Nodes_OK + 1; Withn := Make_With_Clause (Loc, Name => Build_Unit_Name (Nam)); @@ -3002,8 +3001,6 @@ package body Sem_Ch10 is if Nkind (Nam) = N_Expanded_Name then Expand_With_Clause (Item, Prefix (Nam), N); end if; - - New_Nodes_OK := New_Nodes_OK - 1; end Expand_With_Clause; ----------------------- @@ -3165,7 +3162,6 @@ package body Sem_Ch10 is return; end if; - New_Nodes_OK := New_Nodes_OK + 1; Withn := Make_With_Clause (Loc, Name => Build_Unit_Name); Set_Library_Unit (Withn, P); @@ -3183,8 +3179,6 @@ package body Sem_Ch10 is if Is_Child_Spec (P_Unit) then Implicit_With_On_Parent (P_Unit, N); end if; - - New_Nodes_OK := New_Nodes_OK - 1; end Implicit_With_On_Parent; -------------- @@ -3734,8 +3728,6 @@ package body Sem_Ch10 is -- Start of processing for Expand_Limited_With_Clause begin - New_Nodes_OK := New_Nodes_OK + 1; - if Nkind (Nam) = N_Identifier then -- Create node for name of withed unit @@ -3793,8 +3785,6 @@ package body Sem_Ch10 is Install_Limited_Withed_Unit (Withn); end if; end if; - - New_Nodes_OK := New_Nodes_OK - 1; end Expand_Limited_With_Clause; ---------------------- diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 5464d418426..8ec60c7abb3 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -6963,7 +6963,10 @@ package body Sem_Ch6 is -- is precisely evaluated in the pre-state. Otherwise return OK. function Is_Trivial_Post_Or_Ensures (N : Node_Id) return Boolean; - -- Return whether node N is trivially "True" or "False" + -- Return True if node N is trivially "True" or "False", and it comes + -- from source. In particular, nodes that are statically known "True" or + -- "False" by the compiler but not written as such in source code are + -- not considered as trivial. procedure Process_Contract_Cases (Spec : Node_Id); -- This processes the Spec_CTC_List from Spec, processing any contract @@ -7064,7 +7067,8 @@ package body Sem_Ch6 is return Is_Entity_Name (N) and then (Entity (N) = Standard_True or else - Entity (N) = Standard_False); + Entity (N) = Standard_False) + and then Comes_From_Source (N); end Is_Trivial_Post_Or_Ensures; ---------------------------- diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 4f28e1eb1d7..e37056e64fe 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -182,16 +182,19 @@ package body Sem_Elab is In_Init_Proc : Boolean := False); -- This is the internal recursive routine that is called to check for -- possible elaboration error. The argument N is a subprogram call or - -- generic instantiation to be checked, and E is the entity of the called - -- subprogram, or instantiated generic unit. The flag Outer_Scope is the - -- outer level scope for the original call. Inter_Unit_Only is set if the - -- call is only to be checked in the case where it is to another unit (and - -- skipped if within a unit). Generate_Warnings is set to False to suppress - -- warning messages about missing pragma Elaborate_All's. These messages - -- are not wanted for inner calls in the dynamic model. Note that an - -- instance of the Access attribute applied to a subprogram also generates - -- a call to this procedure (since the referenced subprogram may be called - -- later indirectly). Flag In_Init_Proc should be set whenever the current + -- generic instantiation, or 'Access attribute reference to be checked, and + -- E is the entity of the called subprogram, or instantiated generic unit, + -- or subprogram referenced by 'Access. + -- + -- The flag Outer_Scope is the outer level scope for the original call. + -- Inter_Unit_Only is set if the call is only to be checked in the + -- case where it is to another unit (and skipped if within a unit). + -- Generate_Warnings is set to False to suppress warning messages about + -- missing pragma Elaborate_All's. These messages are not wanted for + -- inner calls in the dynamic model. Note that an instance of the Access + -- attribute applied to a subprogram also generates a call to this + -- procedure (since the referenced subprogram may be called later + -- indirectly). Flag In_Init_Proc should be set whenever the current -- context is a type init proc. procedure Check_Bad_Instantiation (N : Node_Id); @@ -519,6 +522,9 @@ package body Sem_Elab is Inst_Case : constant Boolean := Nkind (N) in N_Generic_Instantiation; -- Indicates if we have instantiation case + Access_Case : constant Boolean := Nkind (N) = N_Attribute_Reference; + -- Indicates if we have Access attribute case + Caller_Unit_Internal : Boolean; Callee_Unit_Internal : Boolean; @@ -704,9 +710,9 @@ package body Sem_Elab is Is_Internal_File_Name (Unit_File_Name (Get_Source_Unit (E_Scope))); - -- Do not give a warning if the with'ed unit is internal - -- and this is the generic instantiation case (this saves a - -- lot of hassle dealing with the Text_IO special child units) + -- Do not give a warning if the with'ed unit is internal and this is + -- the generic instantiation case (this saves a lot of hassle dealing + -- with the Text_IO special child units) if Callee_Unit_Internal and Inst_Case then return; @@ -720,9 +726,9 @@ package body Sem_Elab is (Unit_File_Name (Get_Source_Unit (C_Scope))); end if; - -- Do not give a warning if the with'ed unit is internal - -- and the caller is not internal (since the binder always - -- elaborates internal units first). + -- Do not give a warning if the with'ed unit is internal and the + -- caller is not internal (since the binder always elaborates + -- internal units first). if Callee_Unit_Internal and (not Caller_Unit_Internal) then return; @@ -743,15 +749,15 @@ package body Sem_Elab is end if; -- If the call is in an instance, and the called entity is not - -- defined in the same instance, then the elaboration issue - -- focuses around the unit containing the template, it is - -- this unit which requires an Elaborate_All. + -- defined in the same instance, then the elaboration issue focuses + -- around the unit containing the template, it is this unit which + -- requires an Elaborate_All. - -- However, if we are doing dynamic elaboration, we need to - -- chase the call in the usual manner. + -- However, if we are doing dynamic elaboration, we need to chase the + -- call in the usual manner. - -- We do not handle the case of calling a generic formal correctly - -- in the static case. See test 4703-004 to explore this gap ??? + -- We do not handle the case of calling a generic formal correctly in + -- the static case.??? Inst_Caller := Instantiation (Get_Source_File_Index (Sloc (N))); Inst_Callee := Instantiation (Get_Source_File_Index (Sloc (Ent))); @@ -871,6 +877,8 @@ package body Sem_Elab is Ent : Node_Or_Entity_Id); -- Generate a call to Error_Msg_NE with parameters Msg_D or -- Msg_S (for dynamic or static elaboration model), N and Ent. + -- Msg_D is suppressed for the attribute reference case, since + -- we never raise Program_Error for an attribute reference. ------------------ -- Elab_Warning -- @@ -883,7 +891,9 @@ package body Sem_Elab is is begin if Dynamic_Elaboration_Checks then - Error_Msg_NE (Msg_D, N, Ent); + if not Access_Case then + Error_Msg_NE (Msg_D, N, Ent); + end if; else Error_Msg_NE (Msg_S, N, Ent); end if; @@ -892,11 +902,23 @@ package body Sem_Elab is -- Start of processing for Generate_Elab_Warnings begin + -- Instantiation case + if Inst_Case then Elab_Warning ("instantiation of& may raise Program_Error?", "info: instantiation of& during elaboration?", Ent); + -- Indirect call case, warning only in static elaboration + -- case, because the attribute reference itself cannot raise + -- an exception. + + elsif Access_Case then + Elab_Warning + ("", "info: access to& during elaboration?", Ent); + + -- Subprogram call case + else if Nkind (Name (N)) in N_Has_Entity and then Is_Init_Proc (Entity (Name (N))) @@ -922,6 +944,7 @@ package body Sem_Elab is ("\missing pragma Elaborate for&?", "\info: implicit pragma Elaborate for& generated?", W_Scope); + else Elab_Warning ("\missing pragma Elaborate_All for&?", @@ -960,7 +983,8 @@ package body Sem_Elab is Insert_Elab_Check (N, Make_Attribute_Reference (Loc, Attribute_Name => Name_Elaborated, - Prefix => New_Occurrence_Of (Spec_Entity (E_Scope), Loc))); + Prefix => + New_Occurrence_Of (Spec_Entity (E_Scope), Loc))); -- Prevent duplicate elaboration checks on the same call, -- which can happen if the body enclosing the call appears @@ -990,9 +1014,7 @@ package body Sem_Elab is -- Do not generate an Elaborate_All for finalization routines -- which perform partial clean up as part of initialization. - elsif In_Init_Proc - and then Is_Finalization_Procedure (Ent) - then + elsif In_Init_Proc and then Is_Finalization_Procedure (Ent) then null; -- Here we need to generate an implicit elaborate all diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index fd8acc86fcc..ed30b9b5aac 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -854,6 +854,7 @@ package Snames is Name_VADS_Size : constant Name_Id := N + $; -- GNAT Name_Val : constant Name_Id := N + $; Name_Valid : constant Name_Id := N + $; + Name_Valid_Scalars : constant Name_Id := N + $; -- GNAT Name_Value_Size : constant Name_Id := N + $; -- GNAT Name_Variable_Indexing : constant Name_Id := N + $; -- GNAT Name_Version : constant Name_Id := N + $; @@ -1418,6 +1419,7 @@ package Snames is Attribute_VADS_Size, Attribute_Val, Attribute_Valid, + Attribute_Valid_Scalars, Attribute_Value_Size, Attribute_Variable_Indexing, Attribute_Version, diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index cece29465c8..789fb9b5b4d 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -634,12 +634,6 @@ package body Switch.C is Ptr := Ptr + 1; Usage_Requested := True; - -- Processing for H switch - - when 'H' => - Ptr := Ptr + 1; - HLO_Active := True; - -- Processing for i switch when 'i' => |