[multiple changes]
2012-12-05 Thomas Quinot <quinot@adacore.com> * par_sco.adb, scos.ads, put_scos.adb, put_scos.ads, get_scos.adb: Generation of SCOs for aspects. 2012-12-05 Thomas Quinot <quinot@adacore.com> * sem_prag.adb (Check_Precondition_Postcondition): Remove redundant call to Set_SCO_Pragma_Enabled (the pragma will be rewritten into a pragma Check later on, and the call will be made when processing the rewritten pragma). (Analyze_Pragma, case Pragma_Check): Omit call to Set_SCO_Pragma_Enabled if Split_PPC is set. 2012-12-05 Olivier Hainque <hainque@adacore.com> * tracebak.c: Add partial support for Lynx178. 2012-12-05 Hristian Kirtchev <kirtchev@adacore.com> * sem_attr.adb (Analyze_Attribute): Improve the error message related to loop assertions. 2012-12-05 Gary Dismukes <dismukes@adacore.com> * atree.ads: Minor reformatting. From-SVN: r194211
This commit is contained in:
parent
af31bd5750
commit
06ad40d3ec
|
@ -1,3 +1,30 @@
|
|||
2012-12-05 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* par_sco.adb, scos.ads, put_scos.adb, put_scos.ads,
|
||||
get_scos.adb: Generation of SCOs for aspects.
|
||||
|
||||
2012-12-05 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* sem_prag.adb (Check_Precondition_Postcondition): Remove
|
||||
redundant call to Set_SCO_Pragma_Enabled (the pragma will be
|
||||
rewritten into a pragma Check later on, and the call will be
|
||||
made when processing the rewritten pragma).
|
||||
(Analyze_Pragma, case Pragma_Check): Omit call to
|
||||
Set_SCO_Pragma_Enabled if Split_PPC is set.
|
||||
|
||||
2012-12-05 Olivier Hainque <hainque@adacore.com>
|
||||
|
||||
* tracebak.c: Add partial support for Lynx178.
|
||||
|
||||
2012-12-05 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* sem_attr.adb (Analyze_Attribute): Improve
|
||||
the error message related to loop assertions.
|
||||
|
||||
2012-12-05 Gary Dismukes <dismukes@adacore.com>
|
||||
|
||||
* atree.ads: Minor reformatting.
|
||||
|
||||
2012-12-05 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* atree.ads, par-ch4.adb, sem_attr.adb, sem_ch13.adb: Minor
|
||||
|
|
|
@ -107,7 +107,7 @@ package Atree is
|
|||
|
||||
-- Note: the required parentheses surrounding conditional
|
||||
-- and quantified expressions count as a level of parens
|
||||
-- for this purposes, so e.g. in X := (if A then B else C);
|
||||
-- for this purpose, so e.g. in X := (if A then B else C);
|
||||
-- Paren_Count for the right side will be 1.
|
||||
|
||||
-- Comes_From_Source
|
||||
|
|
|
@ -28,8 +28,8 @@ pragma Ada_2005;
|
|||
-- read SCO information from ALI files (Xcov and sco_test). Ada 2005
|
||||
-- constructs may therefore be used freely (and are indeed).
|
||||
|
||||
with Namet; use Namet;
|
||||
with SCOs; use SCOs;
|
||||
with Snames; use Snames;
|
||||
with Types; use Types;
|
||||
|
||||
with Ada.IO_Exceptions; use Ada.IO_Exceptions;
|
||||
|
@ -203,6 +203,8 @@ procedure Get_SCOs is
|
|||
N : Natural;
|
||||
-- Scratch buffer, and index into it
|
||||
|
||||
Nam : Name_Id;
|
||||
|
||||
-- Start of processing for Get_Scos
|
||||
|
||||
begin
|
||||
|
@ -308,7 +310,6 @@ begin
|
|||
declare
|
||||
Typ : Character;
|
||||
Key : Character;
|
||||
Pid : Pragma_Id;
|
||||
|
||||
begin
|
||||
Key := 'S';
|
||||
|
@ -327,7 +328,7 @@ begin
|
|||
-- Loop through items on one line
|
||||
|
||||
loop
|
||||
Pid := Unknown_Pragma;
|
||||
Nam := No_Name;
|
||||
Typ := Nextc;
|
||||
|
||||
case Typ is
|
||||
|
@ -348,25 +349,16 @@ begin
|
|||
Skipc;
|
||||
if Typ = 'P' or else Typ = 'p' then
|
||||
if Nextc not in '1' .. '9' then
|
||||
N := 1;
|
||||
Name_Len := 0;
|
||||
loop
|
||||
Buf (N) := Getc;
|
||||
Name_Len := Name_Len + 1;
|
||||
Name_Buffer (Name_Len) := Getc;
|
||||
exit when Nextc = ':';
|
||||
N := N + 1;
|
||||
end loop;
|
||||
|
||||
Skipc;
|
||||
Skipc; -- Past ':'
|
||||
|
||||
begin
|
||||
Pid :=
|
||||
Pragma_Id'Value ("pragma_" & Buf (1 .. N));
|
||||
exception
|
||||
when Constraint_Error =>
|
||||
|
||||
-- Pid remains set to Unknown_Pragma
|
||||
|
||||
null;
|
||||
end;
|
||||
Nam := Name_Find;
|
||||
end if;
|
||||
end if;
|
||||
end case;
|
||||
|
@ -385,7 +377,7 @@ begin
|
|||
To => Loc2,
|
||||
Last => At_EOL,
|
||||
Pragma_Sloc => No_Location,
|
||||
Pragma_Name => Pid));
|
||||
Pragma_Aspect_Name => Nam));
|
||||
|
||||
if Key = '>' then
|
||||
Key := 'S';
|
||||
|
@ -397,8 +389,21 @@ begin
|
|||
|
||||
-- Decision entry
|
||||
|
||||
when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' =>
|
||||
when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' | 'A' =>
|
||||
Dtyp := C;
|
||||
|
||||
if C = 'A' then
|
||||
Name_Len := 0;
|
||||
while Nextc /= ' ' loop
|
||||
Name_Len := Name_Len + 1;
|
||||
Name_Buffer (Name_Len) := Getc;
|
||||
end loop;
|
||||
Nam := Name_Find;
|
||||
|
||||
else
|
||||
Nam := No_Name;
|
||||
end if;
|
||||
|
||||
Skip_Spaces;
|
||||
|
||||
-- Output header
|
||||
|
@ -421,6 +426,7 @@ begin
|
|||
From => Loc,
|
||||
To => No_Source_Location,
|
||||
Last => False,
|
||||
Pragma_Aspect_Name => Nam,
|
||||
others => <>));
|
||||
end;
|
||||
|
||||
|
|
|
@ -23,6 +23,7 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Aspects; use Aspects;
|
||||
with Atree; use Atree;
|
||||
with Debug; use Debug;
|
||||
with Errout; use Errout;
|
||||
|
@ -131,7 +132,7 @@ package body Par_SCO is
|
|||
To : Source_Ptr;
|
||||
Last : Boolean;
|
||||
Pragma_Sloc : Source_Ptr := No_Location;
|
||||
Pragma_Name : Pragma_Id := Unknown_Pragma);
|
||||
Pragma_Aspect_Name : Name_Id := No_Name);
|
||||
-- Append an entry to SCO_Table with fields set as per arguments
|
||||
|
||||
type Dominant_Info is record
|
||||
|
@ -487,15 +488,22 @@ package body Par_SCO is
|
|||
Loc : Source_Ptr := No_Location;
|
||||
-- Node whose Sloc is used for the decision
|
||||
|
||||
Nam : Name_Id := No_Name;
|
||||
-- For the case of an aspect, aspect name
|
||||
|
||||
begin
|
||||
case T is
|
||||
when 'I' | 'E' | 'W' =>
|
||||
when 'I' | 'E' | 'W' | 'a' =>
|
||||
|
||||
-- For IF, EXIT, WHILE, the token SLOC can be found from
|
||||
-- the SLOC of the parent of the expression.
|
||||
-- For IF, EXIT, WHILE, or aspects, the token SLOC is that of
|
||||
-- the parent of the expression.
|
||||
|
||||
Loc := Sloc (Parent (N));
|
||||
|
||||
if T = 'a' then
|
||||
Nam := Chars (Identifier (Parent (N)));
|
||||
end if;
|
||||
|
||||
when 'G' | 'P' =>
|
||||
|
||||
-- For entry guard, the token sloc is from the N_Entry_Body.
|
||||
|
@ -538,7 +546,15 @@ package body Par_SCO is
|
|||
From => Loc,
|
||||
To => No_Location,
|
||||
Last => False,
|
||||
Pragma_Sloc => Pragma_Sloc);
|
||||
Pragma_Sloc => Pragma_Sloc,
|
||||
Pragma_Aspect_Name => Nam);
|
||||
|
||||
-- For an aspect specification, which will be rewritten into a
|
||||
-- pragma, enter a hash table entry now.
|
||||
|
||||
if T = 'a' then
|
||||
Condition_Pragma_Hash_Table.Set (Loc, SCO_Table.Last);
|
||||
end if;
|
||||
end Output_Header;
|
||||
|
||||
------------------------------
|
||||
|
@ -731,6 +747,8 @@ package body Par_SCO is
|
|||
procedure Populate_SCO_Instance_Table is
|
||||
new Sinput.Iterate_On_Instances (Record_Instance);
|
||||
|
||||
SCO_Index : Nat;
|
||||
|
||||
begin
|
||||
if Debug_Flag_Dot_OO then
|
||||
dsco;
|
||||
|
@ -796,6 +814,24 @@ package body Par_SCO is
|
|||
end;
|
||||
end loop;
|
||||
|
||||
-- Stamp out SCO entries for decisions in disabled constructs (pragmas
|
||||
-- or aspects).
|
||||
|
||||
SCO_Index := 1;
|
||||
while SCO_Index <= SCO_Table.Last loop
|
||||
if Is_Decision (SCO_Table.Table (SCO_Index).C1)
|
||||
and then SCO_Pragma_Disabled
|
||||
(SCO_Table.Table (SCO_Index).Pragma_Sloc)
|
||||
then
|
||||
loop
|
||||
SCO_Table.Table (SCO_Index).C1 := ASCII.NUL;
|
||||
exit when SCO_Table.Table (SCO_Index).Last;
|
||||
SCO_Index := SCO_Index + 1;
|
||||
end loop;
|
||||
end if;
|
||||
SCO_Index := SCO_Index + 1;
|
||||
end loop;
|
||||
|
||||
-- Now the tables are all setup for output to the ALI file
|
||||
|
||||
Write_SCOs_To_ALI_File;
|
||||
|
@ -824,8 +860,30 @@ package body Par_SCO is
|
|||
declare
|
||||
T : SCO_Table_Entry renames SCO_Table.Table (Index);
|
||||
begin
|
||||
pragma Assert (T.C1 = 'S');
|
||||
case T.C1 is
|
||||
when 'S' =>
|
||||
-- Pragma statement
|
||||
|
||||
return T.C2 = 'p';
|
||||
|
||||
when 'A' =>
|
||||
-- Aspect decision (enabled)
|
||||
|
||||
return False;
|
||||
|
||||
when 'a' =>
|
||||
-- Aspect decision (not enabled)
|
||||
|
||||
return True;
|
||||
|
||||
when ASCII.NUL =>
|
||||
-- Nullified disabled SCO
|
||||
|
||||
return True;
|
||||
|
||||
when others =>
|
||||
raise Program_Error;
|
||||
end case;
|
||||
end;
|
||||
|
||||
else
|
||||
|
@ -976,13 +1034,28 @@ package body Par_SCO is
|
|||
T : SCO_Table_Entry renames SCO_Table.Table (Index);
|
||||
|
||||
begin
|
||||
-- Called multiple times for the same sloc (need to allow for
|
||||
-- C2 = 'P') ???
|
||||
-- Note: may be called multiple times for the same sloc, so
|
||||
-- account for the fact that the entry may already have been
|
||||
-- marked enabled.
|
||||
|
||||
pragma Assert (T.C1 = 'S'
|
||||
and then
|
||||
(T.C2 = 'p' or else T.C2 = 'P'));
|
||||
case T.C1 is
|
||||
-- Aspect (decision SCO)
|
||||
|
||||
when 'a' =>
|
||||
T.C1 := 'A';
|
||||
|
||||
when 'A' =>
|
||||
null;
|
||||
|
||||
-- Pragma (statement SCO)
|
||||
|
||||
when 'S' =>
|
||||
pragma Assert (T.C2 = 'p' or else T.C2 = 'P');
|
||||
T.C2 := 'P';
|
||||
|
||||
when others =>
|
||||
raise Program_Error;
|
||||
end case;
|
||||
end;
|
||||
end if;
|
||||
end Set_SCO_Pragma_Enabled;
|
||||
|
@ -998,7 +1071,7 @@ package body Par_SCO is
|
|||
To : Source_Ptr;
|
||||
Last : Boolean;
|
||||
Pragma_Sloc : Source_Ptr := No_Location;
|
||||
Pragma_Name : Pragma_Id := Unknown_Pragma)
|
||||
Pragma_Aspect_Name : Name_Id := No_Name)
|
||||
is
|
||||
begin
|
||||
SCO_Table.Append
|
||||
|
@ -1008,7 +1081,7 @@ package body Par_SCO is
|
|||
To => To_Source_Location (To),
|
||||
Last => Last,
|
||||
Pragma_Sloc => Pragma_Sloc,
|
||||
Pragma_Name => Pragma_Name));
|
||||
Pragma_Aspect_Name => Pragma_Aspect_Name));
|
||||
end Set_Table_Entry;
|
||||
|
||||
------------------------
|
||||
|
@ -1133,6 +1206,9 @@ package body Par_SCO is
|
|||
procedure Traverse_One (N : Node_Id);
|
||||
-- Traverse one declaration or statement
|
||||
|
||||
procedure Traverse_Aspects (N : Node_Id);
|
||||
-- Helper for Traverse_One: traverse N's aspect specifications
|
||||
|
||||
-------------------------
|
||||
-- Set_Statement_Entry --
|
||||
-------------------------
|
||||
|
@ -1162,7 +1238,7 @@ package body Par_SCO is
|
|||
To => To,
|
||||
Last => False,
|
||||
Pragma_Sloc => No_Location,
|
||||
Pragma_Name => Unknown_Pragma);
|
||||
Pragma_Aspect_Name => No_Name);
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
|
@ -1170,7 +1246,7 @@ package body Par_SCO is
|
|||
declare
|
||||
SCE : SC_Entry renames SC.Table (J);
|
||||
Pragma_Sloc : Source_Ptr := No_Location;
|
||||
Pragma_Name : Pragma_Id := Unknown_Pragma;
|
||||
Pragma_Aspect_Name : Name_Id := No_Name;
|
||||
begin
|
||||
-- For the case of a statement SCO for a pragma controlled by
|
||||
-- Set_SCO_Pragma_Enabled, set Pragma_Sloc so that the SCO (and
|
||||
|
@ -1181,10 +1257,12 @@ package body Par_SCO is
|
|||
Pragma_Sloc := SCE.From;
|
||||
Condition_Pragma_Hash_Table.Set
|
||||
(Pragma_Sloc, SCO_Table.Last + 1);
|
||||
Pragma_Name := Get_Pragma_Id (Sinfo.Pragma_Name (SCE.N));
|
||||
Pragma_Aspect_Name := Pragma_Name (SCE.N);
|
||||
pragma Assert (Pragma_Aspect_Name /= No_Name);
|
||||
|
||||
elsif SCE.Typ = 'P' then
|
||||
Pragma_Name := Get_Pragma_Id (Sinfo.Pragma_Name (SCE.N));
|
||||
Pragma_Aspect_Name := Pragma_Name (SCE.N);
|
||||
pragma Assert (Pragma_Aspect_Name /= No_Name);
|
||||
end if;
|
||||
|
||||
Set_Table_Entry
|
||||
|
@ -1194,7 +1272,7 @@ package body Par_SCO is
|
|||
To => SCE.To,
|
||||
Last => (J = SC_Last),
|
||||
Pragma_Sloc => Pragma_Sloc,
|
||||
Pragma_Name => Pragma_Name);
|
||||
Pragma_Aspect_Name => Pragma_Aspect_Name);
|
||||
end;
|
||||
end loop;
|
||||
|
||||
|
@ -1293,6 +1371,76 @@ package body Par_SCO is
|
|||
SD.Append ((Empty, L, T, Current_Pragma_Sloc));
|
||||
end Process_Decisions_Defer;
|
||||
|
||||
----------------------
|
||||
-- Traverse_Aspects --
|
||||
----------------------
|
||||
|
||||
procedure Traverse_Aspects (N : Node_Id) is
|
||||
AN : Node_Id;
|
||||
AE : Node_Id;
|
||||
|
||||
begin
|
||||
AN := First (Aspect_Specifications (N));
|
||||
while Present (AN) loop
|
||||
AE := Expression (AN);
|
||||
|
||||
case Get_Aspect_Id (Chars (Identifier (AN))) is
|
||||
|
||||
-- Aspects rewritten into pragmas controlled by a Check_Policy:
|
||||
-- Current_Pragma_Sloc must be set to the sloc of the aspect
|
||||
-- specification. The corresponding pragma will have the same
|
||||
-- sloc.
|
||||
|
||||
when Aspect_Pre |
|
||||
Aspect_Precondition |
|
||||
Aspect_Post |
|
||||
Aspect_Postcondition =>
|
||||
|
||||
-- SCOs are generated before semantic analysis/expansion:
|
||||
-- PPCs are not split yet.
|
||||
|
||||
pragma Assert (not Split_PPC (AN));
|
||||
|
||||
-- A Pre/Post aspect will be rewritten into a pragma
|
||||
-- Precondition/Postcondition with the same sloc.
|
||||
|
||||
pragma Assert (Current_Pragma_Sloc = No_Location);
|
||||
|
||||
Current_Pragma_Sloc := Sloc (AN);
|
||||
|
||||
-- Create the decision as potentially disabled aspect ('a').
|
||||
-- Set_SCO_Pragma_Enabled will subsequently switch to 'A'.
|
||||
|
||||
Process_Decisions_Defer (AE, 'a');
|
||||
Current_Pragma_Sloc := No_Location;
|
||||
|
||||
-- Aspects whose checks are generated in client units,
|
||||
-- regardless of whether or not the check is activated in the
|
||||
-- unit which contains the declaration.
|
||||
|
||||
when Aspect_Predicate |
|
||||
Aspect_Static_Predicate |
|
||||
Aspect_Dynamic_Predicate |
|
||||
Aspect_Invariant |
|
||||
Aspect_Type_Invariant =>
|
||||
|
||||
Process_Decisions_Defer (AE, 'A');
|
||||
|
||||
-- Other aspects: just process any decision nested in the
|
||||
-- aspect expression.
|
||||
|
||||
when others =>
|
||||
|
||||
if Has_Decision (AE) then
|
||||
Process_Decisions_Defer (AE, 'X');
|
||||
end if;
|
||||
|
||||
end case;
|
||||
|
||||
Next (AN);
|
||||
end loop;
|
||||
end Traverse_Aspects;
|
||||
|
||||
------------------
|
||||
-- Traverse_One --
|
||||
------------------
|
||||
|
@ -1825,6 +1973,9 @@ package body Par_SCO is
|
|||
end if;
|
||||
end case;
|
||||
|
||||
-- Process aspects if present
|
||||
|
||||
Traverse_Aspects (N);
|
||||
end Traverse_One;
|
||||
|
||||
-- Start of processing for Traverse_Declarations_Or_Statements
|
||||
|
|
|
@ -23,10 +23,9 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Namet; use Namet;
|
||||
with Opt; use Opt;
|
||||
with Par_SCO; use Par_SCO;
|
||||
with SCOs; use SCOs;
|
||||
with Snames; use Snames;
|
||||
|
||||
procedure Put_SCOs is
|
||||
Current_SCO_Unit : SCO_Unit_Index := 0;
|
||||
|
@ -195,18 +194,10 @@ begin
|
|||
|
||||
if Sent.C1 = 'S'
|
||||
and then (Sent.C2 = 'P' or else Sent.C2 = 'p')
|
||||
and then Sent.Pragma_Name /= Unknown_Pragma
|
||||
and then Sent.Pragma_Aspect_Name /= No_Name
|
||||
then
|
||||
-- Strip leading "PRAGMA_"
|
||||
|
||||
declare
|
||||
Pnam : constant String :=
|
||||
Sent.Pragma_Name'Img;
|
||||
begin
|
||||
Output_String
|
||||
(Pnam (Pnam'First + 7 .. Pnam'Last));
|
||||
Write_Info_Name (Sent.Pragma_Aspect_Name);
|
||||
Write_Info_Char (':');
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
|
@ -240,23 +231,16 @@ begin
|
|||
|
||||
-- Decision
|
||||
|
||||
when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' =>
|
||||
when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' | 'A' =>
|
||||
Start := Start + 1;
|
||||
|
||||
-- For disabled pragma, or nested decision therein, skip
|
||||
-- decision output.
|
||||
|
||||
if SCO_Pragma_Disabled (T.Pragma_Sloc) then
|
||||
while not SCO_Table.Table (Start).Last loop
|
||||
Start := Start + 1;
|
||||
end loop;
|
||||
|
||||
-- For all other cases output decision line
|
||||
|
||||
else
|
||||
Write_SCO_Initiate (U);
|
||||
Write_Info_Char (T.C1);
|
||||
|
||||
if T.C1 = 'A' then
|
||||
Write_Info_Name (T.Pragma_Aspect_Name);
|
||||
end if;
|
||||
|
||||
if T.C1 /= 'X' then
|
||||
Write_Info_Char (' ');
|
||||
Output_Source_Location (T.From);
|
||||
|
@ -290,7 +274,12 @@ begin
|
|||
end loop;
|
||||
|
||||
Write_Info_Terminate;
|
||||
end if;
|
||||
|
||||
when ASCII.NUL =>
|
||||
|
||||
-- Nullified entry: skip
|
||||
|
||||
null;
|
||||
|
||||
when others =>
|
||||
raise Program_Error;
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2009, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2009-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- --
|
||||
|
@ -28,6 +28,7 @@
|
|||
-- the ALI file. The interface allows control over the destination of the
|
||||
-- output, so that this routine can also be used for debugging purposes.
|
||||
|
||||
with Namet; use Namet;
|
||||
with Types; use Types;
|
||||
|
||||
generic
|
||||
|
@ -43,6 +44,9 @@ generic
|
|||
-- Initiates write of new line to output file, the parameter is the
|
||||
-- keyword character for the line.
|
||||
|
||||
with procedure Write_Info_Name (Nam : Name_Id) is <>;
|
||||
-- Outputs one name
|
||||
|
||||
with procedure Write_Info_Nat (N : Nat) is <>;
|
||||
-- Writes image of N to output file with no leading or trailing blanks
|
||||
|
||||
|
|
|
@ -28,10 +28,7 @@
|
|||
-- the ALI file, and by Get_SCO/Put_SCO to read and write the text form that
|
||||
-- is used in the ALI file.
|
||||
|
||||
with Snames; use Snames;
|
||||
-- Note: used for Pragma_Id only, no other feature from Snames should be used,
|
||||
-- as a simplified version is maintained in Xcov.
|
||||
|
||||
with Namet; use Namet;
|
||||
with Types; use Types;
|
||||
|
||||
with GNAT.Table;
|
||||
|
@ -248,18 +245,21 @@ package SCOs is
|
|||
|
||||
-- C* sloc expression
|
||||
|
||||
-- Here * is one of the following characters:
|
||||
-- Here * is one of the following:
|
||||
|
||||
-- E decision in EXIT WHEN statement
|
||||
-- G decision in entry guard
|
||||
-- I decision in IF statement or if expression
|
||||
-- P decision in pragma Assert/Check/Pre_Condition/Post_Condition
|
||||
-- P decision in pragma Assert / Check / Pre/Post_Condition
|
||||
-- A[name] decision in aspect Pre/Post (aspect name optional)
|
||||
-- W decision in WHILE iteration scheme
|
||||
-- X decision appearing in some other expression context
|
||||
-- X decision in some other expression context
|
||||
|
||||
-- For E, G, I, P, W, sloc is the source location of the EXIT, ENTRY, IF,
|
||||
-- PRAGMA or WHILE token, respectively
|
||||
|
||||
-- For A sloc is the source location of the aspect identifier
|
||||
|
||||
-- For X, sloc is omitted
|
||||
|
||||
-- The expression is a prefix polish form indicating the structure of
|
||||
|
@ -369,10 +369,12 @@ package SCOs is
|
|||
Pragma_Sloc : Source_Ptr := No_Location;
|
||||
-- For the statement SCO for a pragma, or for any expression SCO nested
|
||||
-- in a pragma Debug/Assert/PPC, location of PRAGMA token (used for
|
||||
-- control of SCO output, value not recorded in ALI file).
|
||||
-- control of SCO output, value not recorded in ALI file). For the
|
||||
-- decision SCO for an aspect, or for any expression SCO nested in an
|
||||
-- aspect, location of aspect identifier token (likewise).
|
||||
|
||||
Pragma_Name : Pragma_Id := Unknown_Pragma;
|
||||
-- For the statement SCO for a pragma, gives the pragma name
|
||||
Pragma_Aspect_Name : Name_Id := No_Name;
|
||||
-- For the SCO for a pragma/aspect, gives the pragma/apsect name
|
||||
end record;
|
||||
|
||||
package SCO_Table is new GNAT.Table (
|
||||
|
@ -382,6 +384,11 @@ package SCOs is
|
|||
Table_Initial => 500,
|
||||
Table_Increment => 300);
|
||||
|
||||
Is_Decision : constant array (Character) of Boolean :=
|
||||
('E' | 'G' | 'I' | 'P' | 'A' | 'W' | 'X' => True,
|
||||
others => False);
|
||||
-- Indicates which C1 values correspond to decisions
|
||||
|
||||
-- The SCO_Table_Entry values appear as follows:
|
||||
|
||||
-- Statements
|
||||
|
@ -432,7 +439,20 @@ package SCOs is
|
|||
-- SCO contexts, the only pragmas with decisions are Assert, Check,
|
||||
-- dyadic Debug, Precondition and Postcondition). These entries will
|
||||
-- be omitted in output if the pragma is disabled (see comments for
|
||||
-- statement entries).
|
||||
-- statement entries). This is achieved by setting C1 to NUL for all
|
||||
-- SCO entries of the decision.
|
||||
|
||||
-- Decision (ASPECT)
|
||||
-- C1 = 'A'
|
||||
-- C2 = ' '
|
||||
-- From = aspect identifier
|
||||
-- To = No_Source_Location
|
||||
-- Last = unused
|
||||
|
||||
-- Note: when the parse tree is first scanned, we unconditionally build a
|
||||
-- pragma decision entry for any decision in an aspect (Pre/Post/
|
||||
-- [Type_]Invariant/[Static_|Dynamic_]Predicate). Entries for disabled
|
||||
-- Pre/Post aspects will be omitted from output.
|
||||
|
||||
-- Decision (Expression)
|
||||
-- C1 = 'X'
|
||||
|
|
|
@ -3847,7 +3847,8 @@ package body Sem_Attr is
|
|||
|
||||
if not In_Loop_Assertion then
|
||||
Error_Attr
|
||||
("attribute % must appear within pragma Loop_Assertion", N);
|
||||
("attribute % must appear within pragma Loop_Variant or " &
|
||||
"Loop_Invariant", N);
|
||||
end if;
|
||||
|
||||
-- A Loop_Entry that applies to a given loop statement shall not
|
||||
|
|
|
@ -2181,13 +2181,6 @@ package body Sem_Prag is
|
|||
(Get_Pragma_Arg (Arg2), Standard_String);
|
||||
end if;
|
||||
|
||||
-- For a pragma in the extended main source unit, record enabled
|
||||
-- status in SCO (note: there is never any SCO for an instance).
|
||||
|
||||
if Check_Enabled (Pname) then
|
||||
Set_SCO_Pragma_Enabled (Loc);
|
||||
end if;
|
||||
|
||||
-- If we are within an inlined body, the legality of the pragma
|
||||
-- has been checked already.
|
||||
|
||||
|
@ -7407,7 +7400,7 @@ package body Sem_Prag is
|
|||
|
||||
Check_On := Check_Enabled (Chars (Get_Pragma_Arg (Arg1)));
|
||||
|
||||
if Check_On then
|
||||
if Check_On and then not Split_PPC (N) then
|
||||
Set_SCO_Pragma_Enabled (Loc);
|
||||
end if;
|
||||
|
||||
|
|
|
@ -287,8 +287,9 @@ __gnat_backtrace (void **array,
|
|||
#error Unhandled darwin architecture.
|
||||
#endif
|
||||
|
||||
/*------------------------ PPC AIX/Older Darwin -------------------------*/
|
||||
/*---------------------- PPC AIX/PPC Lynx 178/Older Darwin ------------------*/
|
||||
#elif ((defined (_POWER) && defined (_AIX)) || \
|
||||
(defined (__powerpc__) && defined (__Lynx__) && !defined(__ELF__)) || \
|
||||
(defined (__ppc__) && defined (__APPLE__)))
|
||||
|
||||
#define USE_GENERIC_UNWINDER
|
||||
|
@ -307,9 +308,23 @@ struct layout
|
|||
should to feature a null backchain, AIX might expose a null return
|
||||
address instead. */
|
||||
|
||||
/* Then LynxOS-178 features yet another variation, with return_address
|
||||
== &__start, which we only add conditionally as this symbol is not
|
||||
necessarily present elsewhere. Beware that &bla returns the
|
||||
address of a descriptor when "bla" is a function. Getting the code
|
||||
address requires an extra dereference. */
|
||||
|
||||
#if defined (__Lynx__)
|
||||
extern void __start();
|
||||
#define EXTRA_STOP_CONDITION(CURRENT) ((CURRENT)->return_address == *(void**)&__start)
|
||||
#else
|
||||
#define EXTRA_STOP_CONDITION(CURRENT) (0)
|
||||
#endif
|
||||
|
||||
#define STOP_FRAME(CURRENT, TOP_STACK) \
|
||||
(((void *) (CURRENT) < (TOP_STACK)) \
|
||||
|| (CURRENT)->return_address == NULL)
|
||||
|| (CURRENT)->return_address == NULL \
|
||||
|| EXTRA_STOP_CONDITION(CURRENT))
|
||||
|
||||
/* The PPC ABI has an interesting specificity: the return address saved by a
|
||||
function is located in it's caller's frame, and the save operation only
|
||||
|
|
Loading…
Reference in New Issue