+2013-04-11 Robert Dewar <dewar@adacore.com>
+
+ * exp_ch11.ads, exp_ch11.adb (Expand_N_Raise_Expression): New procedure.
+ * exp_util.adb (Insert_Actions): Add entry for N_Raise_Expression.
+ * expander.adb: Add call to Expand_N_Raise_Expression.
+ * par-ch11.adb (P_Raise_Expression): New procedure.
+ * par-ch4.adb (P_Relation): Handle Raise_Expression.
+ * par.adb (P_Raise_Expression): New procedure.
+ * sem.adb: Add handling for N_Raise_Expression.
+ * sem_ch11.ads, sem_ch11.adb (Analyze_Raise_Expression): New procedure.
+ * sem_res.adb (Resolve): Add handling for N_Raise_Expression.
+ * sinfo.ads, sinfo.adb (N_Raise_Expression): New node.
+ * sprint.adb (Sprint_Node_Actual): Add handling for N_Raise_Expression.
+ * stand.ads (Any_Type): Document use with N_Raise_Expression.
+
2013-04-11 Vincent Celier <celier@adacore.com>
* gnat_ugn.texi: Remove section "The Development Environments"
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
Possible_Local_Raise (N, Standard_Constraint_Error);
end Expand_N_Raise_Constraint_Error;
+ -------------------------------
+ -- Expand_N_Raise_Expression --
+ -------------------------------
+
+ procedure Expand_N_Raise_Expression (N : Node_Id) is
+ Loc : constant Source_Ptr := Sloc (N);
+ Typ : constant Entity_Id := Etype (N);
+ RCE : Node_Id;
+
+ begin
+ Possible_Local_Raise (N, Name (N));
+
+ -- Later we must teach the back end/gigi how to deal with this, but
+ -- for now we will assume the type is Standard_Boolean and transform
+ -- the node to:
+
+ -- do
+ -- raise X [with string]
+ -- in
+ -- raise Consraint_Error;
+
+ -- The raise constraint error can never be executed. It is just a dummy
+ -- node that can be labeled with an arbitrary type.
+
+ RCE := Make_Raise_Constraint_Error (Loc, Reason => CE_Explicit_Raise);
+ Set_Etype (RCE, Typ);
+
+ Rewrite (N,
+ Make_Expression_With_Actions (Loc,
+ Actions => New_List (
+ Make_Raise_Statement (Loc,
+ Name => Name (N),
+ Expression => Expression (N))),
+ Expression => RCE));
+
+ Analyze_And_Resolve (N, Typ);
+ end Expand_N_Raise_Expression;
+
----------------------------------
-- Expand_N_Raise_Program_Error --
----------------------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
procedure Expand_N_Exception_Declaration (N : Node_Id);
procedure Expand_N_Handled_Sequence_Of_Statements (N : Node_Id);
procedure Expand_N_Raise_Constraint_Error (N : Node_Id);
+ procedure Expand_N_Raise_Expression (N : Node_Id);
procedure Expand_N_Raise_Program_Error (N : Node_Id);
procedure Expand_N_Raise_Statement (N : Node_Id);
procedure Expand_N_Raise_Storage_Error (N : Node_Id);
N_Push_Storage_Error_Label |
N_Qualified_Expression |
N_Quantified_Expression |
+ N_Raise_Expression |
N_Range |
N_Range_Constraint |
N_Real_Literal |
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
when N_Raise_Constraint_Error =>
Expand_N_Raise_Constraint_Error (N);
+ when N_Raise_Expression =>
+ Expand_N_Raise_Expression (N);
+
when N_Raise_Program_Error =>
Expand_N_Raise_Program_Error (N);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
return Error;
end P_Exception_Choice;
+ ----------------------------
+ -- 11.3 Raise Expression --
+ ----------------------------
+
+ -- RAISE_EXPRESSION ::= raise [exception_NAME [with string_EXPRESSION]]
+
+ -- The caller has verified that the initial token is RAISE
+
+ -- Error recovery: can raise Error_Resync
+
+ function P_Raise_Expression return Node_Id is
+ Raise_Node : Node_Id;
+
+ begin
+ if Ada_Version < Ada_2012 then
+ Error_Msg_SC ("raise expression is an Ada 2012 feature");
+ Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
+ end if;
+
+ Raise_Node := New_Node (N_Raise_Expression, Token_Ptr);
+ Scan; -- past RAISE
+
+ Set_Name (Raise_Node, P_Name);
+
+ if Token = Tok_With then
+ Scan; -- past WITH
+ Set_Expression (Raise_Node, P_Expression);
+ end if;
+
+ return Raise_Node;
+ end P_Raise_Expression;
+
---------------------------
-- 11.3 Raise Statement --
---------------------------
- -- RAISE_STATEMENT ::= raise [exception_NAME];
+ -- RAISE_STATEMENT ::= raise [exception_NAME with string_EXPRESSION];
-- The caller has verified that the initial token is RAISE
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
-- RELATION ::=
-- SIMPLE_EXPRESSION [not] in MEMBERSHIP_CHOICE_LIST
+ -- | RAISE_EXPRESSION
-- MEMBERSHIP_CHOICE_LIST ::=
-- MEMBERSHIP_CHOICE {'|' MEMBERSHIP CHOICE}
-- MEMBERSHIP_CHOICE ::=
-- CHOICE_EXPRESSION | RANGE | SUBTYPE_MARK
+ -- RAISE_EXPRESSION ::= raise exception_NAME [with string_EXPRESSION]
+
-- On return, Expr_Form indicates the categorization of the expression
-- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
Optok : Source_Ptr;
begin
+ -- First check for raise expression
+
+ if Token = Tok_Raise then
+ Expr_Form := EF_Non_Simple;
+ return P_Raise_Expression;
+ end if;
+
+ -- All other cases
+
Node1 := P_Simple_Expression;
if Token not in Token_Class_Relop then
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
package Ch11 is
function P_Handled_Sequence_Of_Statements return Node_Id;
+ function P_Raise_Expression return Node_Id;
function P_Raise_Statement return Node_Id;
function Parse_Exception_Handlers return List_Id;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
when N_Quantified_Expression =>
Analyze_Quantified_Expression (N);
+ when N_Raise_Expression =>
+ Analyze_Raise_Expression (N);
+
when N_Raise_Statement =>
Analyze_Raise_Statement (N);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
end if;
end Analyze_Handled_Statements;
+ ------------------------------
+ -- Analyze_Raise_Expression --
+ ------------------------------
+
+ procedure Analyze_Raise_Expression (N : Node_Id) is
+ Exception_Id : constant Node_Id := Name (N);
+ Exception_Name : Entity_Id := Empty;
+
+ begin
+ Check_SPARK_Restriction ("raise expression is not allowed", N);
+
+ -- Check exception restrictions on the original source
+
+ if Comes_From_Source (N) then
+ Check_Restriction (No_Exceptions, N);
+ end if;
+
+ Analyze (Exception_Id);
+
+ if Is_Entity_Name (Exception_Id) then
+ Exception_Name := Entity (Exception_Id);
+ end if;
+
+ if No (Exception_Name)
+ or else Ekind (Exception_Name) /= E_Exception
+ then
+ Error_Msg_N
+ ("exception name expected in raise statement", Exception_Id);
+ else
+ Set_Is_Raised (Exception_Name);
+ end if;
+
+ -- Deal with RAISE WITH case
+
+ if Present (Expression (N)) then
+ Check_Compiler_Unit (Expression (N));
+ Analyze_And_Resolve (Expression (N), Standard_String);
+ end if;
+
+ -- Check obsolescent use of Numeric_Error
+
+ if Exception_Name = Standard_Numeric_Error then
+ Check_Restriction (No_Obsolescent_Features, Exception_Id);
+ end if;
+
+ -- Kill last assignment indication
+
+ Kill_Current_Values (Last_Assignment_Only => True);
+
+ -- Set type as Any_Type since we have no information at all on the type
+
+ Set_Etype (N, Any_Type);
+ end Analyze_Raise_Expression;
+
-----------------------------
-- Analyze_Raise_Statement --
-----------------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
package Sem_Ch11 is
procedure Analyze_Exception_Declaration (N : Node_Id);
procedure Analyze_Handled_Statements (N : Node_Id);
+ procedure Analyze_Raise_Expression (N : Node_Id);
procedure Analyze_Raise_Statement (N : Node_Id);
procedure Analyze_Raise_xxx_Error (N : Node_Id);
procedure Analyze_Subprogram_Info (N : Node_Id);
Analyze_Dimension (N);
return;
- -- Return if type = Any_Type (previous error encountered)
+ -- Return if type = Any_Type (previous error encountered). except that
+ -- a Raise_Expression node is OK: it is legitimately labeled this way
+ -- since it provides no information on the context.
- elsif Etype (N) = Any_Type then
+ elsif Etype (N) = Any_Type and then Nkind (N) /= N_Raise_Expression then
Debug_A_Exit ("resolving ", N, " (done, Etype = Any_Type)");
return;
end if;
when N_Qualified_Expression
=> Resolve_Qualified_Expression (N, Ctx_Type);
+ -- Why is the following null, needs a comment ???
+
when N_Quantified_Expression => null;
+ when N_Raise_Expression
+ => Set_Etype (N, Ctx_Type);
+
when N_Raise_xxx_Error
=> Set_Etype (N, Ctx_Type);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
or else NT (N).Nkind = N_Parameter_Specification
or else NT (N).Nkind = N_Pragma_Argument_Association
or else NT (N).Nkind = N_Qualified_Expression
+ or else NT (N).Nkind = N_Raise_Expression
or else NT (N).Nkind = N_Raise_Statement
or else NT (N).Nkind = N_Simple_Return_Statement
or else NT (N).Nkind = N_Type_Conversion
or else NT (N).Nkind = N_Package_Renaming_Declaration
or else NT (N).Nkind = N_Procedure_Call_Statement
or else NT (N).Nkind = N_Procedure_Instantiation
+ or else NT (N).Nkind = N_Raise_Expression
or else NT (N).Nkind = N_Raise_Statement
or else NT (N).Nkind = N_Requeue_Statement
or else NT (N).Nkind = N_Subprogram_Renaming_Declaration
or else NT (N).Nkind = N_Parameter_Specification
or else NT (N).Nkind = N_Pragma_Argument_Association
or else NT (N).Nkind = N_Qualified_Expression
+ or else NT (N).Nkind = N_Raise_Expression
or else NT (N).Nkind = N_Raise_Statement
or else NT (N).Nkind = N_Simple_Return_Statement
or else NT (N).Nkind = N_Type_Conversion
or else NT (N).Nkind = N_Package_Renaming_Declaration
or else NT (N).Nkind = N_Procedure_Call_Statement
or else NT (N).Nkind = N_Procedure_Instantiation
+ or else NT (N).Nkind = N_Raise_Expression
or else NT (N).Nkind = N_Raise_Statement
or else NT (N).Nkind = N_Requeue_Statement
or else NT (N).Nkind = N_Subprogram_Renaming_Declaration
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
-- RELATION ::=
-- SIMPLE_EXPRESSION [not] in MEMBERSHIP_CHOICE_LIST
+ -- | RAISE_EXPRESSION
-- MEMBERSHIP_CHOICE_LIST ::=
-- MEMBERSHIP_CHOICE {'|' MEMBERSHIP CHOICE}
-- In Ada 2005, we have
- -- RAISE_STATEMENT ::= raise; | raise exception_NAME [with EXPRESSION];
+ -- RAISE_STATEMENT ::=
+ -- raise; | raise exception_NAME [with string_EXPRESSION];
-- N_Raise_Statement
-- Sloc points to RAISE
-- Expression (Node3) (set to Empty if no expression present)
-- From_At_End (Flag4-Sem)
+ ----------------------------
+ -- 11.3 Raise Expression --
+ ----------------------------
+
+ -- RAISE_EXPRESSION ::= raise exception_NAME [with string_EXPRESSION]
+
+ -- N_Raise_Expression
+ -- Sloc points to RAISE
+ -- Name (Node2) (always present)
+ -- Expression (Node3) (set to Empty if no expression present)
+ -- plus fields for expression
+
-------------------------------
-- 12.1 Generic Declaration --
-------------------------------
N_Allocator,
N_Case_Expression,
N_Extension_Aggregate,
+ N_Raise_Expression,
N_Range,
N_Real_Literal,
N_Reference,
4 => False, -- unused
5 => False), -- unused
+ N_Raise_Expression =>
+ (1 => False, -- unused
+ 2 => True, -- Name (Node2)
+ 3 => True, -- Expression (Node3)
+ 4 => False, -- unused
+ 5 => False), -- Etype (Node5-Sem)
+
N_Generic_Subprogram_Declaration =>
(1 => True, -- Specification (Node1)
2 => True, -- Generic_Formal_Declarations (List2)
if not Has_Parens then
Write_Char ('(');
end if;
+
Write_Str_With_Col_Check_Sloc ("if ");
Sprint_Node (Condition);
Write_Str_With_Col_Check (" then ");
Write_Str (" => ");
Sprint_Node (Condition (Node));
+ when N_Raise_Expression =>
+ declare
+ Has_Parens : constant Boolean := Paren_Count (Node) > 0;
+
+ begin
+ -- The syntax for raise_expression does not include parentheses
+ -- but sometimes parentheses are required, so unconditionally
+ -- generate them here unless already present.
+
+ if not Has_Parens then
+ Write_Char ('(');
+ end if;
+
+ Write_Str_With_Col_Check_Sloc ("raise ");
+ Sprint_Node (Name (Node));
+
+ if Present (Expression (Node)) then
+ Write_Str_With_Col_Check (" with ");
+ Sprint_Node (Expression (Node));
+ end if;
+
+ if not Has_Parens then
+ Write_Char (')');
+ end if;
+ end;
+
when N_Raise_Constraint_Error =>
-- This node can be used either as a subexpression or as a
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
-- identifier references to prevent cascaded errors.
Any_Type : Entity_Id;
- -- Used to represent some unknown type. Plays an important role in
- -- avoiding cascaded errors, since any node that remains labeled with
- -- this type corresponds to an already issued error message. Any_Type
- -- is propagated to avoid cascaded errors from a single type error.
+ -- Used to represent some unknown type. Any_Type is the type of an
+ -- unresolved operator, and it is the type of a node where a type error
+ -- has been detected. Any_Type plays an important role in avoiding
+ -- cascaded errors, because it is compatible with all other types, and is
+ -- propagated to any expression that has a subexpression of Any_Type.
+ -- When resolving operators, Any_Type is the initial type of the node
+ -- before any of its candidate interpretations has been examined. If after
+ -- examining all of them the type is still Any_Type, the node has no
+ -- possible interpretation and an error can be emitted (and Any_Type will
+ -- be propagated upwards).
+
+ -- There is one situation in which Any_Type is used to legitimately
+ -- represent a case where the type is not known pre-resolution, and
+ -- that is for the N_Raise_Expression node. In this case, the Etype
+ -- being set to Any_Type is normal and does not represent an error.
+ -- In particular, it is compatible with the type of any constituend of
+ -- the enclosing expression, if any. The type is eventually replaced
+ -- with the type of the context, which plays no role in the resolution
+ -- of the Raise_Expression.
Any_Access : Entity_Id;
-- Used to resolve the overloaded literal NULL
projects / thirdparty / gcc.git / commitdiff
