2010-01-26 Robert Dewar <dewar@adacore.com>
+ * par_sco.adb (Traverse_Declarations_Or_Statements): Only generate
+ decisions for pragmas Assert, Check, Precondition, Postcondition if
+ -gnata set.
+ * scos.ads: Update comments.
+ * get_scos.adb, put_scos.adb: Minor fix to code reading statement SCOs.
+ Also remove obsolete code for CT (exit point) SCOs.
+
+2010-01-26 Thomas Quinot <quinot@adacore.com>
+
+ * switch-c.adb: Fix handling of -gnatz*
+
+2010-01-26 Robert Dewar <dewar@adacore.com>
+
* par_sco.adb (Traverse_Declarations_Or_Statements): Separate F/W
qualifiers for FOR/WHILE loops
* scos.ads: Use separate type letters F/W for for/while loops
Add_SCO
(C1 => Key,
- C2 => C,
+ C2 => Typ,
From => Loc1,
To => Loc2,
Last => At_EOL);
end loop;
end;
- -- Exit entry
-
- when 'T' =>
- Get_Sloc_Range (Loc1, Loc2);
- Add_SCO (C1 => 'T', From => Loc1, To => Loc2);
-
-- Decision entry
- when 'I' | 'E' | 'W' | 'X' =>
+ when 'I' | 'E' | 'P' | 'W' | 'X' =>
Dtyp := C;
Skip_Spaces;
C := Getc;
with SCOs; use SCOs;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
+with Snames; use Snames;
with Table;
with GNAT.HTable; use GNAT.HTable;
procedure Process_Decisions (N : Node_Id; T : Character);
-- If N is Empty, has no effect. Otherwise scans the tree for the node N,
- -- to output any decisions it contains. T is one of IEWX (for context of
- -- expresion: if/while/when-exit/expression). If T is other than X, then
- -- the node is always a decision a decision is always present (at the very
- -- least a simple decision is present at the top level).
+ -- to output any decisions it contains. T is one of IEPWX (for context of
+ -- expresion: if/exit when/pragma/while/expression). If T is other than X,
+ -- then a decision is always present (at the very least a simple decision
+ -- is present at the top level).
procedure Process_Decisions (L : List_Id; T : Character);
-- Calls above procedure for each element of the list L
-- any decisions in the exit statement expression.
when N_Exit_Statement =>
- Extend_Statement_Sequence (N, 'E');
+ Extend_Statement_Sequence (N, ' ');
Set_Statement_Entry;
Process_Decisions (Condition (N), 'E');
Set_Statement_Entry;
Traverse_Declarations_Or_Statements (Statements (N));
+ -- Pragma
+
+ when N_Pragma =>
+ Extend_Statement_Sequence (N, 'P');
+
+ -- For pragmas Assert, Check, Precondition, and
+ -- Postcondition, we generate decision entries for the
+ -- condition only if the pragma is enabled. For now, we just
+ -- check Assertions_Enabled, which will be set to reflect
+ -- the presence of -gnata.
+
+ -- Later we should move processing of the relevant pragmas
+ -- to Par_Prag, and properly set the flag Pragma_Enabled at
+ -- parse time, so that we can check this flag instead ???
+
+ -- For all other pragmas, we always generate decision
+ -- entries for any embedded expressions.
+
+ declare
+ Nam : constant Name_Id :=
+ Chars (Pragma_Identifier (N));
+ Arg : Node_Id := First (Pragma_Argument_Associations (N));
+ begin
+ case Nam is
+ when Name_Assert |
+ Name_Check |
+ Name_Precondition |
+ Name_Postcondition =>
+
+ if Nam = Name_Check then
+ Next (Arg);
+ end if;
+
+ if Assertions_Enabled then
+ Process_Decisions (Expression (Arg), 'P');
+ end if;
+
+ when others =>
+ Process_Decisions (N, 'X');
+ end case;
+ end;
+
-- All other cases, which extend the current statement sequence
-- but do not terminate it, even if they have nested decisions.
when N_Generic_Instantiation =>
Typ := 'i';
- when N_Pragma =>
- Typ := 'P';
-
when others =>
Typ := ' ';
end case;
-- Decision
- when 'I' | 'E' | 'W' | 'X' =>
+ when 'I' | 'E' | 'P' | 'W' | 'X' =>
if T.C2 = ' ' then
Start := Start + 1;
end if;
-- Statements
-- C1 = 'S' for entry point, 's' otherwise
- -- C2 = 't', 's', 'o', 'r', 'i',
- -- 'C', 'E', 'F', 'I', 'P', 'R', 'W', ' '
- -- (type/subtype/object/renaming/instantiation/
- -- CASE/EXIT/FOR/IF/PRAGMA/RETURN/WHILE/other)
+ -- C2 = statement type code to appear on CS line (or ' ' if none)
-- From = starting source location
-- To = ending source location
-- Last = False for all but the last entry, True for last entry
-- statements on a single CS line.
-- Decision
- -- C1 = 'I', 'E', 'P', 'W', 'X' (if/exit/pragma/while/expression)
+ -- C1 = decision type code
-- C2 = ' '
-- From = location of IF/EXIT/PRAGMA/WHILE token,
-- No_Source_Location for X
Prag := Spec_PPC_List (Spec_Id);
while Present (Prag) loop
if Pragma_Name (Prag) = Name_Precondition
- and then PPC_Enabled (Prag)
+ and then Pragma_Enabled (Prag)
then
-- Add pragma Check at the start of the declarations of N.
-- Note that this processing reverses the order of the list,
Prag := Spec_PPC_List (Spec_Id);
while Present (Prag) loop
if Pragma_Name (Prag) = Name_Postcondition
- and then PPC_Enabled (Prag)
+ and then Pragma_Enabled (Prag)
then
if Plist = No_List then
Plist := Empty_List;
-- Record whether pragma is enabled
- Set_PPC_Enabled (N, Check_Enabled (Pname));
+ Set_Pragma_Enabled (N, Check_Enabled (Pname));
-- If we are within an inlined body, the legality of the pragma
-- has been checked already.
Check_Arg_Is_Identifier (Arg1);
Check_On := Check_Enabled (Chars (Get_Pragma_Arg (Arg1)));
+ Set_Pragma_Enabled (N, Check_On);
-- If expansion is active and the check is not enabled then we
-- rewrite the Check as:
return Node4 (N);
end Parent_Spec;
- function PPC_Enabled
- (N : Node_Id) return Boolean is
- begin
- pragma Assert (False
- or else NT (N).Nkind = N_Pragma);
- return Flag5 (N);
- end PPC_Enabled;
-
function Position
(N : Node_Id) return Node_Id is
begin
return List2 (N);
end Pragma_Argument_Associations;
+ function Pragma_Enabled
+ (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Pragma);
+ return Flag5 (N);
+ end Pragma_Enabled;
+
function Pragma_Identifier
(N : Node_Id) return Node_Id is
begin
Set_Node4 (N, Val); -- semantic field, no parent set
end Set_Parent_Spec;
- procedure Set_PPC_Enabled
- (N : Node_Id; Val : Boolean := True) is
- begin
- pragma Assert (False
- or else NT (N).Nkind = N_Pragma);
- Set_Flag5 (N, Val);
- end Set_PPC_Enabled;
-
procedure Set_Position
(N : Node_Id; Val : Node_Id) is
begin
Set_List2_With_Parent (N, Val);
end Set_Pragma_Argument_Associations;
+ procedure Set_Pragma_Enabled
+ (N : Node_Id; Val : Boolean := True) is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Pragma);
+ Set_Flag5 (N, Val);
+ end Set_Pragma_Enabled;
+
procedure Set_Pragma_Identifier
(N : Node_Id; Val : Node_Id) is
begin
-- package specification. This field is Empty for library bodies (the
-- parent spec in this case can be found from the corresponding spec).
- -- PPC_Enabled (Flag5-Sem)
- -- Present in N_Pragma nodes. This flag is relevant only for precondition
- -- and postcondition nodes. It is true if the check corresponding to the
- -- pragma type is enabled at the point where the pragma appears.
+ -- Pragma_Enabled (Flag5-Sem)
+ -- Present in N_Pragma nodes. This flag is relevant only for pragmas
+ -- Assert, Check, Precondition, and Postcondition. It is true if the
+ -- check corresponding to the pragma type is enabled at the point where
+ -- the pragma appears.
-- Present_Expr (Uint3-Sem)
-- Present in an N_Variant node. This has a meaningful value only after
-- Debug_Statement (Node3) (set to Empty if not Debug, Assert)
-- Pragma_Identifier (Node4)
-- Next_Rep_Item (Node5-Sem)
- -- PPC_Enabled (Flag5-Sem)
+ -- Pragma_Enabled (Flag5-Sem)
-- Note: we should have a section on what pragmas are passed on to
-- the back end to be processed. This section should note that pragma
function Parent_Spec
(N : Node_Id) return Node_Id; -- Node4
- function PPC_Enabled
- (N : Node_Id) return Boolean; -- Flag5
-
function Position
(N : Node_Id) return Node_Id; -- Node2
function Pragma_Argument_Associations
(N : Node_Id) return List_Id; -- List2
+ function Pragma_Enabled
+ (N : Node_Id) return Boolean; -- Flag5
+
function Pragma_Identifier
(N : Node_Id) return Node_Id; -- Node4
procedure Set_Parent_Spec
(N : Node_Id; Val : Node_Id); -- Node4
- procedure Set_PPC_Enabled
- (N : Node_Id; Val : Boolean := True); -- Flag5
-
procedure Set_Position
(N : Node_Id; Val : Node_Id); -- Node2
procedure Set_Pragma_Argument_Associations
(N : Node_Id; Val : List_Id); -- List2
+ procedure Set_Pragma_Enabled
+ (N : Node_Id; Val : Boolean := True); -- Flag5
+
procedure Set_Pragma_Identifier
(N : Node_Id; Val : Node_Id); -- Node4
pragma Inline (Parameter_List_Truncated);
pragma Inline (Parameter_Type);
pragma Inline (Parent_Spec);
- pragma Inline (PPC_Enabled);
pragma Inline (Position);
pragma Inline (Pragma_Argument_Associations);
+ pragma Inline (Pragma_Enabled);
pragma Inline (Pragma_Identifier);
pragma Inline (Pragmas_After);
pragma Inline (Pragmas_Before);
pragma Inline (Set_Parameter_List_Truncated);
pragma Inline (Set_Parameter_Type);
pragma Inline (Set_Parent_Spec);
- pragma Inline (Set_PPC_Enabled);
pragma Inline (Set_Position);
pragma Inline (Set_Pragma_Argument_Associations);
+ pragma Inline (Set_Pragma_Enabled);
pragma Inline (Set_Pragma_Identifier);
pragma Inline (Set_Pragmas_After);
pragma Inline (Set_Pragmas_Before);
-- Processing for z switch
when 'z' =>
+ -- -gnatz must be the first and only switch in Switch_Chars,
+ -- and is a two-letter switch.
+
+ if Ptr /= Switch_Chars'First + 5
+ or else (Max - Ptr + 1) > 2
+ then
+ Osint.Fail
+ ("-gnatz* may not be combined with other switches");
+ end if;
+
+ if Ptr = Max then
+ Bad_Switch ("-gnatz");
+ end if;
+
Ptr := Ptr + 1;
- -- Allowed for compiler only if this is the only
- -- -z switch, we do not allow multiple occurrences
+ -- Only one occurrence of -gnat* is permitted
if Distribution_Stub_Mode = No_Stubs then
case Switch_Chars (Ptr) is
end case;
Ptr := Ptr + 1;
+
+ else
+ Osint.Fail ("only one -gnatz* switch allowed");
end if;
-- Processing for Z switch
projects / platform / upstream / linaro-gcc.git / commitdiff