Commit 3128f955 by Arnaud Charlet

[multiple changes]

2011-12-05  Bob Duff  <duff@adacore.com>

	* sem_ch3.adb (Derive_Progenitor_Subprograms): Add Ultimate_Alias
	to the Comes_From_Source check, to deal properly with the case
	of indirect inheritance of "=".

2011-12-05  Thomas Quinot  <quinot@adacore.com>

	PR ada/51307
	* s-oscons-tmplt.c: On HP-UX, CLOCK_REALTIME is an enum literal,
	not a macro.

2011-12-05  Thomas Quinot  <quinot@adacore.com>

	* par_sco.adb, scos.ads, put_scos.adb, get_scos.adb: Generate dominance
	information in SCOs.

From-SVN: r182004
parent 9b554be9
2011-12-05 Bob Duff <duff@adacore.com>
* sem_ch3.adb (Derive_Progenitor_Subprograms): Add Ultimate_Alias
to the Comes_From_Source check, to deal properly with the case
of indirect inheritance of "=".
2011-12-05 Thomas Quinot <quinot@adacore.com>
PR ada/51307
* s-oscons-tmplt.c: On HP-UX, CLOCK_REALTIME is an enum literal,
not a macro.
2011-12-05 Thomas Quinot <quinot@adacore.com>
* par_sco.adb, scos.ads, put_scos.adb, get_scos.adb: Generate dominance
information in SCOs.
2011-12-02 Eric Botcazou <ebotcazou@adacore.com> 2011-12-02 Eric Botcazou <ebotcazou@adacore.com>
Thomas Quinot <quinot@adacore.com> Thomas Quinot <quinot@adacore.com>
......
...@@ -266,18 +266,13 @@ begin ...@@ -266,18 +266,13 @@ begin
Pid : Pragma_Id; Pid : Pragma_Id;
begin begin
-- If continuation, reset Last indication in last entry Key := 'S';
-- stored for previous CS or cs line, and start with key
-- set to s for continuations. -- If continuation, reset Last indication in last entry stored
-- for previous CS or cs line.
if C = 's' then if C = 's' then
SCO_Table.Table (SCO_Table.Last).Last := False; SCO_Table.Table (SCO_Table.Last).Last := False;
Key := 's';
-- CS case (first line, so start with key set to S)
else
Key := 'S';
end if; end if;
-- Initialize to scan items on one line -- Initialize to scan items on one line
...@@ -287,39 +282,54 @@ begin ...@@ -287,39 +282,54 @@ begin
-- Loop through items on one line -- Loop through items on one line
loop loop
Pid := Unknown_Pragma;
Typ := Nextc; Typ := Nextc;
if Typ in '1' .. '9' then case Typ is
Typ := ' '; when '>' =>
else -- A dominance marker may be present only at an entry
Skipc; -- point.
if Typ = 'P' then
Pid := Unknown_Pragma; pragma Assert (Key = 'S');
if Nextc not in '1' .. '9' then Key := '>';
N := 1; Typ := Nextc;
loop
Buf (N) := Getc; when '1' .. '9' =>
exit when Nextc = ':'; Typ := ' ';
N := N + 1;
end loop; when others =>
Skipc; Skipc;
if Typ = 'P' then
begin if Nextc not in '1' .. '9' then
Pid := N := 1;
Pragma_Id'Value ("pragma_" & Buf (1 .. N)); loop
exception Buf (N) := Getc;
when Constraint_Error => exit when Nextc = ':';
N := N + 1;
-- Pid remains set to Unknown_Pragma end loop;
Skipc;
null;
end; begin
Pid :=
Pragma_Id'Value ("pragma_" & Buf (1 .. N));
exception
when Constraint_Error =>
-- Pid remains set to Unknown_Pragma
null;
end;
end if;
end if; end if;
end if; end case;
end if;
Get_Source_Location_Range (Loc1, Loc2); if Key = '>' and then Typ /= 'E' then
Get_Source_Location (Loc1);
Loc2 := No_Source_Location;
else
Get_Source_Location_Range (Loc1, Loc2);
end if;
SCO_Table.Append SCO_Table.Append
((C1 => Key, ((C1 => Key,
...@@ -330,8 +340,11 @@ begin ...@@ -330,8 +340,11 @@ begin
Pragma_Sloc => No_Location, Pragma_Sloc => No_Location,
Pragma_Name => Pid)); Pragma_Name => Pid));
if Key = '>' then
Key := 'S';
end if;
exit when At_EOL; exit when At_EOL;
Key := 's';
end loop; end loop;
end; end;
......
...@@ -133,9 +133,9 @@ begin ...@@ -133,9 +133,9 @@ begin
begin begin
case T.C1 is case T.C1 is
-- Statements -- Statements (and dominance markers)
when 'S' => when 'S' | '>' =>
Ctr := 0; Ctr := 0;
Continuation := False; Continuation := False;
loop loop
...@@ -161,9 +161,15 @@ begin ...@@ -161,9 +161,15 @@ begin
Sent : SCO_Table_Entry Sent : SCO_Table_Entry
renames SCO_Table.Table (Start); renames SCO_Table.Table (Start);
begin begin
if Sent.C1 = '>' then
Write_Info_Char (Sent.C1);
end if;
if Sent.C2 /= ' ' then if Sent.C2 /= ' ' then
Write_Info_Char (Sent.C2); Write_Info_Char (Sent.C2);
if Sent.C2 = 'P'
if Sent.C1 = 'S'
and then Sent.C2 = 'P'
and then Sent.Pragma_Name /= Unknown_Pragma and then Sent.Pragma_Name /= Unknown_Pragma
then then
declare declare
...@@ -179,7 +185,15 @@ begin ...@@ -179,7 +185,15 @@ begin
end if; end if;
end if; end if;
Output_Range (Sent); -- For dependence markers (except E), output sloc.
-- For >E and all statement entries, output sloc
-- range.
if Sent.C1 = '>' and then Sent.C2 /= 'E' then
Output_Source_Location (Sent.From);
else
Output_Range (Sent);
end if;
end; end;
-- Increment entry counter (up to 6 entries per line, -- Increment entry counter (up to 6 entries per line,
...@@ -194,19 +208,12 @@ begin ...@@ -194,19 +208,12 @@ begin
<<Next_Statement>> <<Next_Statement>>
exit when SCO_Table.Table (Start).Last; exit when SCO_Table.Table (Start).Last;
Start := Start + 1; Start := Start + 1;
pragma Assert (SCO_Table.Table (Start).C1 = 's');
end loop; end loop;
if Ctr > 0 then if Ctr > 0 then
Write_Info_Terminate; Write_Info_Terminate;
end if; end if;
-- Statement continuations should not occur since they
-- are supposed to have been handled in the loop above.
when 's' =>
raise Program_Error;
-- Decision -- Decision
when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' => when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' =>
......
...@@ -1343,7 +1343,13 @@ CST(Inet_Pton_Linkname, "") ...@@ -1343,7 +1343,13 @@ CST(Inet_Pton_Linkname, "")
*/ */
#ifdef CLOCK_REALTIME /* Note: On HP-UX, CLOCK_REALTIME is an enum, not a macro. */
#if defined(CLOCK_REALTIME) || defined (__hpux__)
# define HAVE_CLOCK_REALTIME
#endif
#ifdef HAVE_CLOCK_REALTIME
CND(CLOCK_REALTIME, "System realtime clock") CND(CLOCK_REALTIME, "System realtime clock")
#endif #endif
...@@ -1377,7 +1383,7 @@ CND(CLOCK_THREAD_CPUTIME_ID, "Thread CPU clock") ...@@ -1377,7 +1383,7 @@ CND(CLOCK_THREAD_CPUTIME_ID, "Thread CPU clock")
# define CLOCK_RT_Ada "CLOCK_MONOTONIC" # define CLOCK_RT_Ada "CLOCK_MONOTONIC"
# define NEED_PTHREAD_CONDATTR_SETCLOCK # define NEED_PTHREAD_CONDATTR_SETCLOCK
#elif defined(CLOCK_REALTIME) #elif defined(HAVE_CLOCK_REALTIME)
/* By default use CLOCK_REALTIME */ /* By default use CLOCK_REALTIME */
# define CLOCK_RT_Ada "CLOCK_REALTIME" # define CLOCK_RT_Ada "CLOCK_REALTIME"
#endif #endif
......
...@@ -135,14 +135,14 @@ package SCOs is ...@@ -135,14 +135,14 @@ package SCOs is
-- any statement with a label (the label itself is not part of the -- any statement with a label (the label itself is not part of the
-- entry point that is recorded). -- entry point that is recorded).
-- Each entry point must appear as the first entry on a CS line. -- Each entry point must appear as the first statement entry on a CS
-- The idea is that if any simple statement on a CS line is known to have -- line. Thus, if any simple statement on a CS line is known to have
-- been executed, then all statements that appear before it on the same -- been executed, then all statements that appear before it on the same
-- CS line are certain to also have been executed. -- CS line are certain to also have been executed.
-- The form of a statement line in the ALI file is: -- The form of a statement line in the ALI file is:
-- CS *sloc-range [*sloc-range...] -- CS [dominance] *sloc-range [*sloc-range...]
-- where each sloc-range corresponds to a single statement, and * is -- where each sloc-range corresponds to a single statement, and * is
-- one of: -- one of:
...@@ -165,6 +165,23 @@ package SCOs is ...@@ -165,6 +165,23 @@ package SCOs is
-- and is omitted for all other cases -- and is omitted for all other cases
-- The optional dominance marker is of the form gives additional
-- information as to how the sequence of statements denoted by the CS
-- line can be entered:
-- >F<sloc>
-- sequence is entered only if the decision at <sloc> is False
-- >T<sloc>
-- sequence is entered only if the decision at <sloc> is True
-- >S<sloc>
-- sequence is entered only if the statement at <sloc> has been
-- executed
-- >E<sloc-range>
-- sequence is the sequence of statements for a exception_handler
-- with the given sloc range
-- Note: up to 6 entries can appear on a single CS line. If more than 6 -- Note: up to 6 entries can appear on a single CS line. If more than 6
-- entries appear in one logical statement sequence, continuation lines -- entries appear in one logical statement sequence, continuation lines
-- are marked by Cs and appear immediately after the CS line. -- are marked by Cs and appear immediately after the CS line.
...@@ -381,7 +398,7 @@ package SCOs is ...@@ -381,7 +398,7 @@ package SCOs is
-- The SCO_Table_Entry values appear as follows: -- The SCO_Table_Entry values appear as follows:
-- Statements -- Statements
-- C1 = 'S' for entry point, 's' otherwise -- C1 = 'S'
-- C2 = statement type code to appear on CS line (or ' ' if none) -- C2 = statement type code to appear on CS line (or ' ' if none)
-- From = starting source location -- From = starting source location
-- To = ending source location -- To = ending source location
...@@ -400,6 +417,15 @@ package SCOs is ...@@ -400,6 +417,15 @@ package SCOs is
-- Set_SCO_Pragma_Enabled changes C2 to 'P' to cause the entry to be -- Set_SCO_Pragma_Enabled changes C2 to 'P' to cause the entry to be
-- emitted in Put_SCOs. -- emitted in Put_SCOs.
-- Dominance marker
-- C1 = '>'
-- C2 = 'F'/'T'/'S'/'E'
-- From = Decision/statement sloc ('F'/'T'/'S'),
-- handler first sloc ('E')
-- To = No_Source_Location ('F'/'T'/'S'), handler last sloc ('E')
-- Note: A dominance marker is always followed by a statement entry.
-- Decision (EXIT/entry guard/IF/WHILE) -- Decision (EXIT/entry guard/IF/WHILE)
-- C1 = 'E'/'G'/'I'/'W' (for EXIT/entry Guard/IF/WHILE) -- C1 = 'E'/'G'/'I'/'W' (for EXIT/entry Guard/IF/WHILE)
-- C2 = ' ' -- C2 = ' '
......
...@@ -12820,14 +12820,15 @@ package body Sem_Ch3 is ...@@ -12820,14 +12820,15 @@ package body Sem_Ch3 is
Iface_Subp := Node (Prim_Elmt); Iface_Subp := Node (Prim_Elmt);
-- Exclude derivation of predefined primitives except those -- Exclude derivation of predefined primitives except those
-- that come from source. Required to catch declarations of -- that come from source, or are inherited from one that comes
-- equality operators of interfaces. For example: -- from source. Required to catch declarations of equality
-- operators of interfaces. For example:
-- type Iface is interface; -- type Iface is interface;
-- function "=" (Left, Right : Iface) return Boolean; -- function "=" (Left, Right : Iface) return Boolean;
if not Is_Predefined_Dispatching_Operation (Iface_Subp) if not Is_Predefined_Dispatching_Operation (Iface_Subp)
or else Comes_From_Source (Iface_Subp) or else Comes_From_Source (Ultimate_Alias (Iface_Subp))
then then
E := Find_Primitive_Covering_Interface E := Find_Primitive_Covering_Interface
(Tagged_Type => Tagged_Type, (Tagged_Type => Tagged_Type,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment