From f56578295717025ee266066527da6d28dd856699 Mon Sep 17 00:00:00 2001 From: charlet Date: Wed, 31 Aug 2011 09:18:57 +0000 Subject: [PATCH] 2011-08-31 Robert Dewar * sem_ch4.adb: Minor reformatting. * sem_ch6.adb: Minor code reorganization (use Ekind_In). 2011-08-31 Thomas Quinot * scos.ads: Minor documentation clarification. * put_scos.adb: Do not generate SCO unit header line for a unit that has no SCO lines. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178367 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 11 +++++++++++ gcc/ada/put_scos.adb | 52 +++++++++++++++++++++++++++++++++++----------------- gcc/ada/scos.ads | 4 ++-- gcc/ada/sem_ch4.adb | 14 ++++++++++---- gcc/ada/sem_ch6.adb | 5 ++--- 5 files changed, 60 insertions(+), 26 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 92f89a9..24abfae 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,16 @@ 2011-08-31 Robert Dewar + * sem_ch4.adb: Minor reformatting. + * sem_ch6.adb: Minor code reorganization (use Ekind_In). + +2011-08-31 Thomas Quinot + + * scos.ads: Minor documentation clarification. + * put_scos.adb: Do not generate SCO unit header line for a unit that + has no SCO lines. + +2011-08-31 Robert Dewar + * a-rbtgbo.adb, alfa_test.adb: Minor reformatting. 2011-08-31 Tristan Gingold diff --git a/gcc/ada/put_scos.adb b/gcc/ada/put_scos.adb index 4706c00..32427df 100644 --- a/gcc/ada/put_scos.adb +++ b/gcc/ada/put_scos.adb @@ -28,7 +28,11 @@ with SCOs; use SCOs; with Snames; use Snames; procedure Put_SCOs is - Ctr : Nat; + Current_SCO_Unit : SCO_Unit_Index := 0; + -- Initial value must not be a valid unit index + + procedure Write_SCO_Initiate (SU : SCO_Unit_Index); + -- Start SCO line for unit SU, also emitting SCO unit header if necessary procedure Output_Range (T : SCO_Table_Entry); -- Outputs T.From and T.To in line:col-line:col format @@ -72,10 +76,34 @@ procedure Put_SCOs is end loop; end Output_String; + ------------------------ + -- Write_SCO_Initiate -- + ------------------------ + + procedure Write_SCO_Initiate (SU : SCO_Unit_Index) is + SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (SU); + begin + if Current_SCO_Unit /= SU then + Write_Info_Initiate ('C'); + Write_Info_Char (' '); + Write_Info_Nat (SUT.Dep_Num); + Write_Info_Char (' '); + + Output_String (SUT.File_Name.all); + + Write_Info_Terminate; + + Current_SCO_Unit := SU; + end if; + + Write_Info_Initiate ('C'); + end Write_SCO_Initiate; + -- Start of processing for Put_SCOs begin - -- Loop through entries in SCO_Unit_Table + -- Loop through entries in SCO_Unit_Table. Note that entry 0 is by + -- convention present but unused. for U in 1 .. SCO_Unit_Table.Last loop declare @@ -88,19 +116,6 @@ begin Start := SUT.From; Stop := SUT.To; - -- Write unit header (omitted if no SCOs are generated for this unit) - - if Start <= Stop then - Write_Info_Initiate ('C'); - Write_Info_Char (' '); - Write_Info_Nat (SUT.Dep_Num); - Write_Info_Char (' '); - - Output_String (SUT.File_Name.all); - - Write_Info_Terminate; - end if; - -- Loop through SCO entries for this unit loop @@ -111,6 +126,9 @@ begin T : SCO_Table_Entry renames SCO_Table.Table (Start); Continuation : Boolean; + Ctr : Nat; + -- Counter for statement entries + begin case T.C1 is @@ -127,7 +145,7 @@ begin end if; if Ctr = 0 then - Write_Info_Initiate ('C'); + Write_SCO_Initiate (U); if not Continuation then Write_Info_Char ('S'); Continuation := True; @@ -204,7 +222,7 @@ begin -- For all other cases output decision line else - Write_Info_Initiate ('C'); + Write_SCO_Initiate (U); Write_Info_Char (T.C1); if T.C1 /= 'X' then diff --git a/gcc/ada/scos.ads b/gcc/ada/scos.ads index 7c0bb82..904c6bf 100644 --- a/gcc/ada/scos.ads +++ b/gcc/ada/scos.ads @@ -458,8 +458,8 @@ package SCOs is -- This table keeps track of the units and the corresponding starting and -- ending indexes (From, To) in the SCO table. Note that entry zero is - -- unused, it is for convenience in calling the sort routine. Thus the - -- real lower bound for active entries is 1. + -- present but unused, it is for convenience in calling the sort routine. + -- Thus the lower bound for real entries is 1. type SCO_Unit_Index is new Int; -- Used to index values in this table. Values start at 1 and are assigned diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 3f03aee..e5299b2 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -277,7 +277,8 @@ package body Sem_Ch4 is -- the call may be overloaded with both interpretations. function Try_Object_Operation - (N : Node_Id; CW_Test_Only : Boolean := False) return Boolean; + (N : Node_Id; + CW_Test_Only : Boolean := False) return Boolean; -- Ada 2005 (AI-252): Support the object.operation notation. If node N -- is a call in this notation, it is transformed into a normal subprogram -- call where the prefix is a parameter, and True is returned. If node @@ -1763,6 +1764,9 @@ package body Sem_Ch4 is -- Start of processing for Analyze_Explicit_Dereference begin + -- If source node, check SPARK restriction. We guard this with the + -- source node check, because ??? + if Comes_From_Source (N) then Check_SPARK_Restriction ("explicit dereference is not allowed", N); end if; @@ -4185,15 +4189,17 @@ package body Sem_Ch4 is -- Duplicate the call. This is required to avoid problems with -- the tree transformations performed by Try_Object_Operation. - and then Try_Object_Operation - (N => Sinfo.Name (New_Copy_Tree (Parent (N))), - CW_Test_Only => True) + and then + Try_Object_Operation + (N => Sinfo.Name (New_Copy_Tree (Parent (N))), + CW_Test_Only => True) then return; end if; end if; if Etype (N) = Any_Type and then Is_Protected_Type (Prefix_Type) then + -- Case of a prefix of a protected type: selector might denote -- an invisible private component. diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index b4d5849..290b53d 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1355,9 +1355,8 @@ package body Sem_Ch6 is for J in reverse 0 .. Scope_Stack.Last loop Result := Scope_Stack.Table (J).Entity; - exit when Ekind (Result) /= E_Block - and then Ekind (Result) /= E_Loop - and then Chars (Result) /= Name_uPostconditions; + exit when not Ekind_In (Result, E_Block, E_Loop) + and then Chars (Result) /= Name_uPostconditions; end loop; pragma Assert (Present (Result)); -- 2.7.4