diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2011-08-31 11:18:57 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2011-08-31 11:18:57 +0200 |
commit | 11bc76df472d71d80fd669d2d5966030a8ae4ea1 (patch) | |
tree | 1e0e14b9fcdfad6fef24c03f9231abd24dda5d36 /gcc | |
parent | 876d4394d2e36fbfc16a6600763ca35b2d5624c5 (diff) | |
download | gcc-11bc76df472d71d80fd669d2d5966030a8ae4ea1.zip gcc-11bc76df472d71d80fd669d2d5966030a8ae4ea1.tar.gz gcc-11bc76df472d71d80fd669d2d5966030a8ae4ea1.tar.bz2 |
[multiple changes]
2011-08-31 Robert Dewar <dewar@adacore.com>
* sem_ch4.adb: Minor reformatting.
* sem_ch6.adb: Minor code reorganization (use Ekind_In).
2011-08-31 Thomas Quinot <quinot@adacore.com>
* scos.ads: Minor documentation clarification.
* put_scos.adb: Do not generate SCO unit header line for a unit that
has no SCO lines.
From-SVN: r178367
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 11 | ||||
-rw-r--r-- | gcc/ada/put_scos.adb | 52 | ||||
-rw-r--r-- | gcc/ada/scos.ads | 4 | ||||
-rw-r--r-- | gcc/ada/sem_ch4.adb | 14 | ||||
-rw-r--r-- | 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 <dewar@adacore.com> + * sem_ch4.adb: Minor reformatting. + * sem_ch6.adb: Minor code reorganization (use Ekind_In). + +2011-08-31 Thomas Quinot <quinot@adacore.com> + + * 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 <dewar@adacore.com> + * a-rbtgbo.adb, alfa_test.adb: Minor reformatting. 2011-08-31 Tristan Gingold <gingold@adacore.com> 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)); |