From 3ab42ff720f3457149a27baf2e8340eef6a93ed0 Mon Sep 17 00:00:00 2001 From: charlet Date: Thu, 13 Oct 2011 10:47:00 +0000 Subject: [PATCH] 2011-10-13 Robert Dewar * exp_ch5.adb, sem_ch3.adb, impunit.adb, impunit.ads, sem_type.adb, prj-proc.adb, exp_ch9.adb, s-regpat.adb, sem_ch10.adb, sem_prag.adb, sem_ch12.adb, freeze.adb, sem_attr.adb, sem_attr.ads, gnatlink.adb, par-ch6.adb, exp_ch6.adb, sem_ch4.adb, sem_ch6.adb, sem_ch8.adb, par-util.adb, sem_ch13.adb, lib-xref.adb, g-trasym.adb, g-trasym.ads, exp_aggr.adb, s-taprop-posix.adb: Minor reformatting. 2011-10-13 Geert Bosch * s-gearop.adb: Minor comment additions. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@179907 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 13 +++++++++++++ gcc/ada/exp_aggr.adb | 2 +- gcc/ada/exp_ch5.adb | 2 +- gcc/ada/exp_ch6.adb | 16 +++++++--------- gcc/ada/exp_ch9.adb | 3 +-- gcc/ada/freeze.adb | 6 +++--- gcc/ada/g-trasym.adb | 6 ++++-- gcc/ada/g-trasym.ads | 7 +++++-- gcc/ada/gnatlink.adb | 2 +- gcc/ada/impunit.adb | 2 +- gcc/ada/impunit.ads | 5 +++-- gcc/ada/lib-xref.adb | 6 +++--- gcc/ada/par-ch6.adb | 2 +- gcc/ada/par-util.adb | 2 +- gcc/ada/prj-proc.adb | 19 +++++++++++++++---- gcc/ada/s-gearop.adb | 41 ++++++++++++++++++++++++----------------- gcc/ada/s-regpat.adb | 8 +++++--- gcc/ada/s-taprop-posix.adb | 6 ++++++ gcc/ada/sem_attr.adb | 13 +++++++++++++ gcc/ada/sem_attr.ads | 14 +++++++------- gcc/ada/sem_ch10.adb | 2 +- gcc/ada/sem_ch12.adb | 28 ++++++++++++++++------------ gcc/ada/sem_ch13.adb | 1 + gcc/ada/sem_ch3.adb | 4 +--- gcc/ada/sem_ch4.adb | 4 ++-- gcc/ada/sem_ch6.adb | 6 +++--- gcc/ada/sem_ch8.adb | 1 - gcc/ada/sem_prag.adb | 17 +++++++++++------ gcc/ada/sem_type.adb | 4 ++-- 29 files changed, 152 insertions(+), 90 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8b75024..c8602ce 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2011-10-13 Robert Dewar + + * exp_ch5.adb, sem_ch3.adb, impunit.adb, impunit.ads, sem_type.adb, + prj-proc.adb, exp_ch9.adb, s-regpat.adb, sem_ch10.adb, sem_prag.adb, + sem_ch12.adb, freeze.adb, sem_attr.adb, sem_attr.ads, gnatlink.adb, + par-ch6.adb, exp_ch6.adb, sem_ch4.adb, sem_ch6.adb, sem_ch8.adb, + par-util.adb, sem_ch13.adb, lib-xref.adb, g-trasym.adb, g-trasym.ads, + exp_aggr.adb, s-taprop-posix.adb: Minor reformatting. + +2011-10-13 Geert Bosch + + * s-gearop.adb: Minor comment additions. + 2011-10-13 Fedor Rybin * gnat_ugn.texi: Add gnattest section. diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index b48b228..783772f 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -3515,7 +3515,7 @@ package body Exp_Aggr is -- active, if this is a preelaborable unit or a -- predefined unit. This ensures that predefined -- units get the same level of constant folding in - -- Ada 95 and Ada 05, where their categorization + -- Ada 95 and Ada 2005, where their categorization -- has changed. declare diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 75aa2a5..8d48772 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -3466,8 +3466,8 @@ package body Exp_Ch5 is -- remain there. pragma Assert (First_Entity (Scope (Loop_Id)) = Loop_Id); - Set_First_Entity (Scope (Loop_Id), Next_Entity (Loop_Id)); + if Last_Entity (Scope (Loop_Id)) = Loop_Id then Set_Last_Entity (Scope (Loop_Id), Empty); end if; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index abcd9cd..5252e7c 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -254,9 +254,9 @@ package body Exp_Ch6 is Add_Extra_Actual_To_Call (Function_Call, Obj_Acc_Formal, Obj_Address); end Add_Access_Actual_To_Build_In_Place_Call; - -------------------------------------------------- + ------------------------------------------------------ -- Add_Unconstrained_Actuals_To_Build_In_Place_Call -- - -------------------------------------------------- + ------------------------------------------------------ procedure Add_Unconstrained_Actuals_To_Build_In_Place_Call (Function_Call : Node_Id; @@ -5285,13 +5285,13 @@ package body Exp_Ch6 is else SS_Allocator := New_Copy_Tree (Heap_Allocator); - -- The heap and pool allocators are marked + -- The heap and pool allocators are marked as -- Comes_From_Source since they correspond to an -- explicit user-written allocator (that is, it will -- only be executed on behalf of callers that call the - -- function as initialization for such an - -- allocator). This prevents errors when - -- No_Implicit_Heap_Allocations is in force. + -- function as initialization for such an allocator). + -- Prevents errors when No_Implicit_Heap_Allocations + -- is in force. Set_Comes_From_Source (Heap_Allocator, True); Set_Comes_From_Source (Pool_Allocator, True); @@ -8218,9 +8218,7 @@ package body Exp_Ch6 is else Add_Unconstrained_Actuals_To_Build_In_Place_Call - (Func_Call, - Function_Id, - Alloc_Form => Secondary_Stack); + (Func_Call, Function_Id, Alloc_Form => Secondary_Stack); Caller_Object := Empty; Establish_Transient_Scope (Object_Decl, Sec_Stack => True); diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index f6d6b16..e02f4c0 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -2934,8 +2934,7 @@ package body Exp_Ch9 is Insert_Before (Context, Master_Decl); Analyze (Master_Decl); - -- Mark the enclosing scope and its associated construct as being task - -- masters. + -- Mark enclosing scope and its associated construct as task masters Set_Has_Master_Entity (Master_Scop); diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index b82fb80..8c42fed 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1409,7 +1409,6 @@ package body Freeze is if Nkind (Decl) = N_Subprogram_Renaming_Declaration then if Error_Posted (Decl) then Set_Has_Completion (E); - else Build_And_Analyze_Renamed_Body (Decl, E, After); end if; @@ -1621,8 +1620,8 @@ package body Freeze is -- Start of processing for Check_Current_Instance begin - -- In Ada 95, the (imprecise) rule is that the current instance of a - -- limited type is aliased. In Ada 2005, limitedness must be + -- In Ada 95, the (imprecise) rule is that the current instance + -- of a limited type is aliased. In Ada 2005, limitedness must be -- explicit: either a tagged type, or a limited record. if Is_Limited_Type (Rec_Type) @@ -1651,6 +1650,7 @@ package body Freeze is if Nkind (Decl) = N_Full_Type_Declaration then declare Tdef : constant Node_Id := Type_Definition (Decl); + begin if Nkind (Tdef) = N_Modular_Type_Definition then declare diff --git a/gcc/ada/g-trasym.adb b/gcc/ada/g-trasym.adb index 12793c8..ac2444e 100644 --- a/gcc/ada/g-trasym.adb +++ b/gcc/ada/g-trasym.adb @@ -30,8 +30,8 @@ ------------------------------------------------------------------------------ -- This is the default implementation for platforms where the full capability --- is not supported. It returns tracebacks as lists of "0x..." strings --- corresponding to the addresses. +-- is not supported. It returns tracebacks as lists of LF separated strings of +-- the form "0x..." corresponding to the addresses. with Ada.Exceptions.Traceback; use Ada.Exceptions.Traceback; with System.Address_Image; @@ -51,8 +51,10 @@ package body GNAT.Traceback.Symbolic is else declare Img : String := System.Address_Image (Traceback (Traceback'First)); + Result : String (1 .. (Img'Length + 3) * Traceback'Length); Last : Natural := 0; + begin for J in Traceback'Range loop Img := System.Address_Image (Traceback (J)); diff --git a/gcc/ada/g-trasym.ads b/gcc/ada/g-trasym.ads index 679d236..4b30600 100644 --- a/gcc/ada/g-trasym.ads +++ b/gcc/ada/g-trasym.ads @@ -42,6 +42,10 @@ -- OpenVMS Alpha and ia64 -- Windows +-- Note: on targets other than those listed above, a dummy implementation of +-- the body returns a series of LF separated strings of the form "0x..." +-- corresponding to the addresses. + -- The routines provided in this package assume that your application has -- been compiled with debugging information turned on, since this information -- is used to build a symbolic traceback. @@ -87,8 +91,7 @@ package GNAT.Traceback.Symbolic is pragma Elaborate_Body; function Symbolic_Traceback (Traceback : Tracebacks_Array) return String; - -- Build a string containing a symbolic traceback of the given call chain - -- + -- Build a string containing a symbolic traceback of the given call chain. -- Note: This procedure may be installed by Set_Trace_Decorator, to get a -- symbolic traceback on all exceptions raised (see GNAT.Exception_Traces). diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index de9d491..9a1aab4 100644 --- a/gcc/ada/gnatlink.adb +++ b/gcc/ada/gnatlink.adb @@ -1616,7 +1616,7 @@ begin if Arg'Length > 8 and then (Arg (Arg'First + 6 .. Arg'First + 8) = "rtp" - or else Arg (Arg'Last - 2 .. Arg'Last) = "rtp") + or else Arg (Arg'Last - 2 .. Arg'Last) = "rtp") then Linker_Options.Increment_Last; Linker_Options.Table (Linker_Options.Last) := diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index be1d057..dfe176b 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -61,7 +61,7 @@ package body Impunit is -- The following is a giant string list containing the names of all non- -- implementation internal files, i.e. the complete list of files for -- internal units which a program may legitimately WITH when operating in - -- either Ada 95 or Ada 05 mode. + -- either Ada 95 or Ada 2005 mode. -- Note that this list should match the list of units documented in the -- "GNAT Library" section of the GNAT Reference Manual. A unit listed here diff --git a/gcc/ada/impunit.ads b/gcc/ada/impunit.ads index e524493..be3e8d3 100644 --- a/gcc/ada/impunit.ads +++ b/gcc/ada/impunit.ads @@ -25,8 +25,9 @@ -- This package contains data and functions used to determine if a given unit -- is an internal unit intended only for use by the implementation and which --- should not be directly WITH'ed by user code. It also checks for Ada 05 --- units that should only be WITH'ed in Ada 05 mode. +-- should not be directly WITH'ed by user code. It also checks for Ada 2005 +-- units that should only be WITH'ed in Ada 2005 mode, and Ada 2012 units +-- that should only be WITH'ed in Ada 2012 mode. with Types; use Types; diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index d46e646..83a06e4 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -1910,9 +1910,9 @@ package body Lib.Xref is Op := Ultimate_Alias (Old_E); - -- Normal case of no alias present - -- we omit generated primitives like tagged equality, - -- that have no source representation. + -- Normal case of no alias present. We omit generated + -- primitives like tagged equality, that have no source + -- representation. else Op := Old_E; diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb index 7a9df3a..cb0575b 100644 --- a/gcc/ada/par-ch6.adb +++ b/gcc/ada/par-ch6.adb @@ -184,7 +184,7 @@ package body Ch6 is Scope.Table (Scope.Last).Ecol := Start_Column; Scope.Table (Scope.Last).Lreq := False; - -- Ada 2005: scan leading NOT OVERRIDING indicator + -- Ada 2005: Scan leading NOT OVERRIDING indicator if Token = Tok_Not then Scan; -- past NOT diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb index 32a3a88..259cfb8 100644 --- a/gcc/ada/par-util.adb +++ b/gcc/ada/par-util.adb @@ -201,7 +201,7 @@ package body Util is -- Note: we deliberately do not emit these warnings when operating in -- Ada 83 mode because in that case we assume the user is building - -- legacy code anyway. + -- legacy code anyway and is not interested in updating Ada versions. end Check_Future_Keyword; diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 269bc45..a46ee23 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -145,6 +145,7 @@ package body Prj.Proc is procedure Recursive_Process (In_Tree : Project_Tree_Ref; Project : out Project_Id; + Packages_To_Check : String_List_Access; From_Project_Node : Project_Node_Id; From_Project_Node_Tree : Project_Node_Tree_Ref; Env : in out Prj.Tree.Environment; @@ -1347,6 +1348,7 @@ package body Prj.Proc is procedure Process (In_Tree : Project_Tree_Ref; Project : out Project_Id; + Packages_To_Check : String_List_Access; Success : out Boolean; From_Project_Node : Project_Node_Id; From_Project_Node_Tree : Project_Node_Tree_Ref; @@ -1361,6 +1363,7 @@ package body Prj.Proc is From_Project_Node => From_Project_Node, From_Project_Node_Tree => From_Project_Node_Tree, Env => Env, + Packages_To_Check => Packages_To_Check, Reset_Tree => Reset_Tree); if Project_Qualifier_Of @@ -2325,6 +2328,7 @@ package body Prj.Proc is procedure Process_Project_Tree_Phase_1 (In_Tree : Project_Tree_Ref; Project : out Project_Id; + Packages_To_Check : String_List_Access; Success : out Boolean; From_Project_Node : Project_Node_Id; From_Project_Node_Tree : Project_Node_Tree_Ref; @@ -2349,6 +2353,7 @@ package body Prj.Proc is Recursive_Process (Project => Project, In_Tree => In_Tree, + Packages_To_Check => Packages_To_Check, From_Project_Node => From_Project_Node, From_Project_Node_Tree => From_Project_Node_Tree, Env => Env, @@ -2482,6 +2487,7 @@ package body Prj.Proc is procedure Recursive_Process (In_Tree : Project_Tree_Ref; Project : out Project_Id; + Packages_To_Check : String_List_Access; From_Project_Node : Project_Node_Id; From_Project_Node_Tree : Project_Node_Tree_Ref; Env : in out Prj.Tree.Environment; @@ -2539,9 +2545,9 @@ package body Prj.Proc is Recursive_Process (In_Tree => In_Tree, Project => New_Project, + Packages_To_Check => Packages_To_Check, From_Project_Node => - Project_Node_Of - (With_Clause, From_Project_Node_Tree), + Project_Node_Of (With_Clause, From_Project_Node_Tree), From_Project_Node_Tree => From_Project_Node_Tree, Env => Env, Extended_By => No_Project); @@ -2596,6 +2602,7 @@ package body Prj.Proc is Prj.Part.Parse (In_Tree => From_Project_Node_Tree, Project => Loaded_Project, + Packages_To_Check => Packages_To_Check, Project_File_Name => Get_Name_String (List.Path), Errout_Handling => Prj.Part.Never_Finalize, Current_Directory => Get_Name_String (Project.Directory.Name), @@ -2627,6 +2634,7 @@ package body Prj.Proc is Process_Project_Tree_Phase_1 (In_Tree => Tree, Project => List.Project, + Packages_To_Check => Packages_To_Check, Success => Success, From_Project_Node => Loaded_Project, From_Project_Node_Tree => From_Project_Node_Tree, @@ -2638,6 +2646,7 @@ package body Prj.Proc is Process_Project_Tree_Phase_1 (In_Tree => Tree, Project => List.Project, + Packages_To_Check => Packages_To_Check, Success => Success, From_Project_Node => Loaded_Project, From_Project_Node_Tree => From_Project_Node_Tree, @@ -2859,8 +2868,10 @@ package body Prj.Proc is Recursive_Process (In_Tree => In_Tree, Project => Project.Extends, - From_Project_Node => Extended_Project_Of - (Declaration_Node, From_Project_Node_Tree), + Packages_To_Check => Packages_To_Check, + From_Project_Node => + Extended_Project_Of + (Declaration_Node, From_Project_Node_Tree), From_Project_Node_Tree => From_Project_Node_Tree, Env => Env, Extended_By => Project); diff --git a/gcc/ada/s-gearop.adb b/gcc/ada/s-gearop.adb index cb07f40..ddff7be 100644 --- a/gcc/ada/s-gearop.adb +++ b/gcc/ada/s-gearop.adb @@ -109,7 +109,8 @@ package body System.Generic_Array_Operations is Target : Integer; Source : Integer; Factor : Scalar); - -- Needs comments ??? + -- Elementary row operation that subtracts Factor * M (Source, <>) from + -- M (Target, <>) procedure Sub_Row (M : in out Matrix; @@ -161,24 +162,31 @@ package body System.Generic_Array_Operations is function "abs" (X : Scalar) return Scalar is (if X < Zero then Zero - X else X); + -- The following are variations of the elementary matrix row operations: + -- row switching, row multiplication and row addition. Because in this + -- algorithm the addition factor is always a negated value, we chose to + -- use row subtraction instead. Similarly, instead of multiplying by + -- a reciprocal, we divide. + procedure Sub_Row (M : in out Matrix; Target : Integer; Source : Integer; Factor : Scalar); - -- Needs commenting ??? + -- Subtrace Factor * M (Source, <>) from M (Target, <>) procedure Divide_Row (M, N : in out Matrix; Row : Integer; Scale : Scalar); - -- Needs commenting ??? + -- Divide M (Row) and N (Row) by Scale, and update Det procedure Switch_Row (M, N : in out Matrix; Row_1 : Integer; Row_2 : Integer); - -- Needs commenting ??? + -- Exchange M (Row_1) and N (Row_1) with M (Row_2) and N (Row_2), + -- negating Det in the process. ------------- -- Sub_Row -- @@ -254,8 +262,7 @@ package body System.Generic_Array_Operations is end if; end Switch_Row; - I : Integer := M'First (1); - -- Avoid use of I ??? + Row : Integer := M'First (1); -- Start of processing for Forward_Eliminate @@ -264,35 +271,35 @@ package body System.Generic_Array_Operations is for J in M'Range (2) loop declare - Max_I : Integer := I; + Max_Row : Integer := Row; Max_Abs : Scalar := Zero; begin - -- Find best pivot in column J, starting in row I + -- Find best pivot in column J, starting in row Row - for K in I .. M'Last (1) loop + for K in Row .. M'Last (1) loop declare New_Abs : constant Scalar := abs M (K, J); begin if Max_Abs < New_Abs then Max_Abs := New_Abs; - Max_I := K; + Max_Row := K; end if; end; end loop; if Zero < Max_Abs then - Switch_Row (M, N, I, Max_I); - Divide_Row (M, N, I, M (I, J)); + Switch_Row (M, N, Row, Max_Row); + Divide_Row (M, N, Row, M (Row, J)); - for U in I + 1 .. M'Last (1) loop - Sub_Row (N, U, I, M (U, J)); - Sub_Row (M, U, I, M (U, J)); + for U in Row + 1 .. M'Last (1) loop + Sub_Row (N, U, Row, M (U, J)); + Sub_Row (M, U, Row, M (U, J)); end loop; - exit when I >= M'Last (1); + exit when Row >= M'Last (1); - I := I + 1; + Row := Row + 1; else Det := Zero; -- Zero, but we don't have literals diff --git a/gcc/ada/s-regpat.adb b/gcc/ada/s-regpat.adb index ac938be..cee229e 100755 --- a/gcc/ada/s-regpat.adb +++ b/gcc/ada/s-regpat.adb @@ -2013,11 +2013,13 @@ package body System.Regpat is Must_Have_Length => Dummy.Must_Have_Length, Paren_Count => Dummy.Paren_Count, Flags => Dummy.Flags, - Program => Dummy.Program - (Dummy.Program'First .. Dummy.Program'First + Size - 1)); + Program => + Dummy.Program + (Dummy.Program'First .. Dummy.Program'First + Size - 1)); else -- We have to recompile now that we know the size - -- ??? Can we use Ada 05's return construct ? + -- ??? Can we use Ada 2005's return construct ? + declare Result : Pattern_Matcher (Size); begin diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb index dd99623..425508a 100644 --- a/gcc/ada/s-taprop-posix.adb +++ b/gcc/ada/s-taprop-posix.adb @@ -1089,6 +1089,9 @@ package body System.Task_Primitives.Operations is Result := pthread_mutex_destroy (S.L'Access); pragma Assert (Result = 0); + -- Storage_Error is propagated as intended if the allocation of the + -- underlying OS entities fails. + raise Storage_Error; end if; @@ -1102,6 +1105,9 @@ package body System.Task_Primitives.Operations is Result := pthread_condattr_destroy (Cond_Attr'Access); pragma Assert (Result = 0); + -- Storage_Error is propagated as intended if the allocation of the + -- underlying OS entities fails. + raise Storage_Error; end if; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 7b15644..ae7edbf 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1229,7 +1229,14 @@ package body Sem_Attr is procedure Check_Enum_Image is Lit : Entity_Id; + begin + -- When an enumeration type appears in an attribute reference, all + -- literals of the type are marked as referenced. This must only be + -- done if the attribute reference appears in the current source. + -- Otherwise the information on references may differ between a + -- normal compilation and one that performs inlining. + if Is_Enumeration_Type (P_Base_Type) and then In_Extended_Main_Code_Unit (N) then @@ -5037,6 +5044,12 @@ package body Sem_Attr is -- Case of enumeration type + -- When an enumeration type appears in an attribute reference, all + -- literals of the type are marked as referenced. This must only be + -- done if the attribute reference appears in the current source. + -- Otherwise the information on references may differ between a + -- normal compilation and one that performs inlining. + if Is_Enumeration_Type (P_Type) and then In_Extended_Main_Code_Unit (N) then diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads index 0e8561a..a12d5a7 100644 --- a/gcc/ada/sem_attr.ads +++ b/gcc/ada/sem_attr.ads @@ -607,12 +607,12 @@ package Sem_Attr is (Typ : Entity_Id; Nam : TSS_Name_Type; Partial_View : Entity_Id := Empty) return Boolean; - -- For a limited type Typ, return True iff the given attribute is - -- available. For Ada 05, availability is defined by 13.13.2(36/1). For Ada - -- 95, an attribute is considered to be available if it has been specified - -- using an attribute definition clause for the type, or for its full view, - -- or for an ancestor of either. Parameter Partial_View is used only - -- internally, when checking for an attribute definition clause that is not - -- visible (Ada 95 only). + -- For a limited type Typ, return True if and only if the given attribute + -- is available. For Ada 2005, availability is defined by 13.13.2(36/1). + -- For Ada 95, an attribute is considered to be available if it has been + -- specified using an attribute definition clause for the type, or for its + -- full view, or for an ancestor of either. Parameter Partial_View is used + -- only internally, when checking for an attribute definition clause that + -- is not visible (Ada 95 only). end Sem_Attr; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 17fe121..98a57e2 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -208,7 +208,7 @@ package body Sem_Ch10 is -- Limited_With_Clauses -- -------------------------- - -- Limited_With clauses are the mechanism chosen for Ada 05 to support + -- Limited_With clauses are the mechanism chosen for Ada 2005 to support -- mutually recursive types declared in different units. A limited_with -- clause that names package P in the context of unit U makes the types -- declared in the visible part of P available within U, but with the diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 9da8614..b1963f3 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -1573,12 +1573,14 @@ package body Sem_Ch12 is (T : Entity_Id; Def : Node_Id) is - Loc : constant Source_Ptr := Sloc (Def); - Base : constant Entity_Id := - New_Internal_Entity - (E_Decimal_Fixed_Point_Type, - Current_Scope, - Sloc (Defining_Identifier (Parent (Def))), 'G'); + Loc : constant Source_Ptr := Sloc (Def); + + Base : constant Entity_Id := + New_Internal_Entity + (E_Decimal_Fixed_Point_Type, + Current_Scope, + Sloc (Defining_Identifier (Parent (Def))), 'G'); + Int_Base : constant Entity_Id := Standard_Integer; Delta_Val : constant Ureal := Ureal_1; Digs_Val : constant Uint := Uint_6; @@ -1719,7 +1721,8 @@ package body Sem_Ch12 is Base : constant Entity_Id := New_Internal_Entity (E_Floating_Point_Type, Current_Scope, - Sloc (Defining_Identifier (Parent (Def))), 'G'); + Sloc (Defining_Identifier (Parent (Def))), 'G'); + begin Enter_Name (T); Set_Ekind (T, E_Enumeration_Subtype); @@ -1768,7 +1771,7 @@ package body Sem_Ch12 is Base : constant Entity_Id := New_Internal_Entity (E_Floating_Point_Type, Current_Scope, - Sloc (Defining_Identifier (Parent (Def))), 'G'); + Sloc (Defining_Identifier (Parent (Def))), 'G'); begin -- The various semantic attributes are taken from the predefined type @@ -1987,7 +1990,8 @@ package body Sem_Ch12 is Base : constant Entity_Id := New_Internal_Entity (E_Ordinary_Fixed_Point_Type, Current_Scope, - Sloc (Defining_Identifier (Parent (Def))), 'G'); + Sloc (Defining_Identifier (Parent (Def))), 'G'); + begin -- The semantic attributes are set for completeness only, their values -- will never be used, since all properties of the type are non-static. @@ -2410,9 +2414,9 @@ package body Sem_Ch12 is is Base : constant Entity_Id := New_Internal_Entity - (E_Signed_Integer_Type, - Current_Scope, - Sloc (Defining_Identifier (Parent (Def))), 'G'); + (E_Signed_Integer_Type, + Current_Scope, + Sloc (Defining_Identifier (Parent (Def))), 'G'); begin Enter_Name (T); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 02c9325..3a5a9fd 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -3364,6 +3364,7 @@ package body Sem_Ch13 is -- No statements other than code statements, pragmas, and labels. -- Again we allow certain internally generated statements. + -- In Ada 2012, qualified expressions are names, and the code -- statement is initially parsed as a procedure call. diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 918763d..607f51c 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -16895,10 +16895,8 @@ package body Sem_Ch3 is when N_Conditional_Expression => declare Then_Expr : constant Node_Id := - Next - (First (Expressions (Original_Node (Exp)))); + Next (First (Expressions (Original_Node (Exp)))); Else_Expr : constant Node_Id := Next (Then_Expr); - begin return OK_For_Limited_Init_In_05 (Typ, Then_Expr) and then OK_For_Limited_Init_In_05 (Typ, Else_Expr); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 7f54ba5..9bd6bbd 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -3434,8 +3434,8 @@ package body Sem_Ch4 is -- of the high bound. procedure Check_Universal_Expression (N : Node_Id); - -- In Ada 83, reject bounds of a universal range that are not - -- literals or entity names. + -- In Ada83, reject bounds of a universal range that are not literals or + -- entity names. ----------------------- -- Check_Common_Type -- diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 2e9c97f..c6ce39a 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -388,9 +388,9 @@ package body Sem_Ch6 is begin Analyze (P); - -- A call of the form A.B (X) may be an Ada 05 call, which is rewritten - -- as B (A, X). If the rewriting is successful, the call has been - -- analyzed and we just return. + -- A call of the form A.B (X) may be an Ada 2005 call, which is + -- rewritten as B (A, X). If the rewriting is successful, the call + -- has been analyzed and we just return. if Nkind (P) = N_Selected_Component and then Name (N) /= P diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 21f535c..17f802f 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -2402,7 +2402,6 @@ package body Sem_Ch8 is if not Is_Actual then Error_Msg_N ("expect valid subprogram name in renaming", N); - else Error_Msg_NE ("no visible subprogram for formal&", N, Nam); end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 9a55bf8..40afb8b 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -13762,13 +13762,18 @@ package body Sem_Prag is Error_Msg_N ("Unchecked_Union must not be tagged", Typ); return; - else - if not Has_Discriminants (Typ) then - Error_Msg_N - ("Unchecked_Union must have one discriminant", Typ); - return; - end if; + elsif not Has_Discriminants (Typ) then + Error_Msg_N + ("Unchecked_Union must have one discriminant", Typ); + return; + + -- Note: in previous versions of GNAT we used to check for limited + -- types and give an error, but in fact the standard does allow + -- Unchecked_Union on limited types, so this check was removed. + -- Proceed with basic error checks completed + + else Discr := First_Discriminant (Typ); while Present (Discr) loop if No (Discriminant_Default_Value (Discr)) then diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 067a2d4..fff01b1 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -1992,8 +1992,8 @@ package body Sem_Type is -- exclude the universal_fixed operator, which often causes ambiguities -- in legacy code. - -- Ditto in Ada 2012, where an ambiguity may arise for an operation on - -- a partial view that is completed with a fixed point type. See + -- Ditto in Ada 2012, where an ambiguity may arise for an operation + -- on a partial view that is completed with a fixed point type. See -- AI05-0020 and AI05-0209. The ambiguity is resolved in favor of the -- user-defined subprogram so that a client of the package has the -- same resulution as the body of the package. -- 2.7.4