Commit e49b74a9 by Arnaud Charlet

g-regpat.adb (Fail): raise Expression_Error including the diagnostic message, friendlier.

	* g-regpat.adb (Fail): raise Expression_Error including the diagnostic
	message, friendlier.

From-SVN: r106984
parent 383b2b42
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1986 by University of Toronto. -- -- Copyright (C) 1986 by University of Toronto. --
-- Copyright (C) 1996-2004 Ada Core Technologies, Inc. -- -- Copyright (C) 1999-2005, AdaCore --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -129,7 +129,7 @@ package body GNAT.Regpat is ...@@ -129,7 +129,7 @@ package body GNAT.Regpat is
-- Complex loops -- Complex loops
CURLYX, -- 2num node Match this complex thing {n,m} times CURLYX, -- 2num node Match this complex thing {n,m} times
-- The nums are coded on two characters each. -- The nums are coded on two characters each
WHILEM, -- no Do curly processing and see if rest matches WHILEM, -- no Do curly processing and see if rest matches
...@@ -233,15 +233,15 @@ package body GNAT.Regpat is ...@@ -233,15 +233,15 @@ package body GNAT.Regpat is
procedure Set_In_Class procedure Set_In_Class
(Bitmap : in out Character_Class; (Bitmap : in out Character_Class;
C : Character); C : Character);
-- Set the entry to True for C in the class Bitmap. -- Set the entry to True for C in the class Bitmap
function Get_From_Class function Get_From_Class
(Bitmap : Character_Class; (Bitmap : Character_Class;
C : Character) return Boolean; C : Character) return Boolean;
-- Return True if the entry is set for C in the class Bitmap. -- Return True if the entry is set for C in the class Bitmap
procedure Reset_Class (Bitmap : out Character_Class); procedure Reset_Class (Bitmap : out Character_Class);
-- Clear all the entries in the class Bitmap. -- Clear all the entries in the class Bitmap
pragma Inline (Set_In_Class); pragma Inline (Set_In_Class);
pragma Inline (Get_From_Class); pragma Inline (Get_From_Class);
...@@ -282,7 +282,7 @@ package body GNAT.Regpat is ...@@ -282,7 +282,7 @@ package body GNAT.Regpat is
function Get_Next_Offset function Get_Next_Offset
(Program : Program_Data; (Program : Program_Data;
IP : Pointer) return Pointer; IP : Pointer) return Pointer;
-- Get the offset field of a node. Used by Get_Next. -- Get the offset field of a node. Used by Get_Next
function Get_Next function Get_Next
(Program : Program_Data; (Program : Program_Data;
...@@ -295,7 +295,7 @@ package body GNAT.Regpat is ...@@ -295,7 +295,7 @@ package body GNAT.Regpat is
function Read_Natural function Read_Natural
(Program : Program_Data; (Program : Program_Data;
IP : Pointer) return Natural; IP : Pointer) return Natural;
-- Return the 2-byte natural coded at position IP. -- Return the 2-byte natural coded at position IP
-- All of the subprograms above are tiny and should be inlined -- All of the subprograms above are tiny and should be inlined
...@@ -389,10 +389,10 @@ package body GNAT.Regpat is ...@@ -389,10 +389,10 @@ package body GNAT.Regpat is
-- Return value is the location of new opcode, ie old Emit_Ptr. -- Return value is the location of new opcode, ie old Emit_Ptr.
procedure Emit_Natural (IP : Pointer; N : Natural); procedure Emit_Natural (IP : Pointer; N : Natural);
-- Split N on two characters at position IP. -- Split N on two characters at position IP
procedure Emit_Class (Bitmap : Character_Class); procedure Emit_Class (Bitmap : Character_Class);
-- Emits a character class. -- Emits a character class
procedure Case_Emit (C : Character); procedure Case_Emit (C : Character);
-- Emit C, after converting is to lower-case if the regular -- Emit C, after converting is to lower-case if the regular
...@@ -454,7 +454,7 @@ package body GNAT.Regpat is ...@@ -454,7 +454,7 @@ package body GNAT.Regpat is
function Next_Instruction (P : Pointer) return Pointer; function Next_Instruction (P : Pointer) return Pointer;
-- Dig the "next" pointer out of a node -- Dig the "next" pointer out of a node
procedure Fail (M : in String); procedure Fail (M : String);
pragma No_Return (Fail); pragma No_Return (Fail);
-- Fail with a diagnostic message, if possible -- Fail with a diagnostic message, if possible
...@@ -572,9 +572,9 @@ package body GNAT.Regpat is ...@@ -572,9 +572,9 @@ package body GNAT.Regpat is
-- Fail -- -- Fail --
---------- ----------
procedure Fail (M : in String) is procedure Fail (M : String) is
begin begin
raise Expression_Error; raise Expression_Error with M;
end Fail; end Fail;
------------------------- -------------------------
...@@ -845,7 +845,7 @@ package body GNAT.Regpat is ...@@ -845,7 +845,7 @@ package body GNAT.Regpat is
-- makes it hard to avoid. -- makes it hard to avoid.
procedure Parse procedure Parse
(Parenthesized : in Boolean; (Parenthesized : Boolean;
Flags : out Expression_Flags; Flags : out Expression_Flags;
IP : out Pointer) IP : out Pointer)
is is
...@@ -1206,7 +1206,7 @@ package body GNAT.Regpat is ...@@ -1206,7 +1206,7 @@ package body GNAT.Regpat is
Parse_Pos := Parse_Pos + 1; Parse_Pos := Parse_Pos + 1;
end if; end if;
-- First character can be ] or -, without closing the class. -- First character can be ] or - without closing the class
if Parse_Pos <= Parse_End if Parse_Pos <= Parse_End
and then (Expression (Parse_Pos) = ']' and then (Expression (Parse_Pos) = ']'
...@@ -2389,7 +2389,7 @@ package body GNAT.Regpat is ...@@ -2389,7 +2389,7 @@ package body GNAT.Regpat is
type Natural_Array is array (Match_Count range <>) of Natural; type Natural_Array is array (Match_Count range <>) of Natural;
Matches_Tmp : Natural_Array (Matches_Full'Range); Matches_Tmp : Natural_Array (Matches_Full'Range);
-- Save the opening position of parenthesis. -- Save the opening position of parenthesis
Last_Paren : Natural := 0; Last_Paren : Natural := 0;
-- Last parenthesis seen -- Last parenthesis seen
...@@ -2414,7 +2414,7 @@ package body GNAT.Regpat is ...@@ -2414,7 +2414,7 @@ package body GNAT.Regpat is
-- operators for complex expressions. -- operators for complex expressions.
Current_Curly : Current_Curly_Access := null; Current_Curly : Current_Curly_Access := null;
-- The curly currently being processed. -- The curly currently being processed
----------------------- -----------------------
-- Local Subprograms -- -- Local Subprograms --
...@@ -2430,7 +2430,7 @@ package body GNAT.Regpat is ...@@ -2430,7 +2430,7 @@ package body GNAT.Regpat is
-- It only matches on things of length 1. -- It only matches on things of length 1.
-- Starting from Input_Pos, it matches at most Max CURLY. -- Starting from Input_Pos, it matches at most Max CURLY.
function Try (Pos : in Positive) return Boolean; function Try (Pos : Positive) return Boolean;
-- Try to match at specific point -- Try to match at specific point
function Match (IP : Pointer) return Boolean; function Match (IP : Pointer) return Boolean;
...@@ -2465,7 +2465,7 @@ package body GNAT.Regpat is ...@@ -2465,7 +2465,7 @@ package body GNAT.Regpat is
pragma Inline (Index); pragma Inline (Index);
pragma Inline (Repeat); pragma Inline (Repeat);
-- These are two complex functions, but used only once. -- These are two complex functions, but used only once
pragma Inline (Match_Whilem); pragma Inline (Match_Whilem);
pragma Inline (Match_Simple_Operator); pragma Inline (Match_Simple_Operator);
...@@ -3002,10 +3002,10 @@ package body GNAT.Regpat is ...@@ -3002,10 +3002,10 @@ package body GNAT.Regpat is
Ln : Natural := 0; Ln : Natural := 0;
Lastloc : constant Natural := Cc.Lastloc; Lastloc : constant Natural := Cc.Lastloc;
-- Detection of 0-len. -- Detection of 0-len
begin begin
-- If degenerate scan matches "", assume scan done. -- If degenerate scan matches "", assume scan done
if Input_Pos = Cc.Lastloc if Input_Pos = Cc.Lastloc
and then N >= Cc.Min and then N >= Cc.Min
...@@ -3031,7 +3031,7 @@ package body GNAT.Regpat is ...@@ -3031,7 +3031,7 @@ package body GNAT.Regpat is
return False; return False;
end if; end if;
-- First, just match a string of min scans. -- First, just match a string of min scans
if N < Cc.Min then if N < Cc.Min then
Cc.Cur := N; Cc.Cur := N;
...@@ -3046,7 +3046,7 @@ package body GNAT.Regpat is ...@@ -3046,7 +3046,7 @@ package body GNAT.Regpat is
return False; return False;
end if; end if;
-- Prefer next over scan for minimal matching. -- Prefer next over scan for minimal matching
if not Cc.Greedy then if not Cc.Greedy then
Current_Curly := Cc.Old_Cc; Current_Curly := Cc.Old_Cc;
...@@ -3240,7 +3240,7 @@ package body GNAT.Regpat is ...@@ -3240,7 +3240,7 @@ package body GNAT.Regpat is
-- Try -- -- Try --
--------- ---------
function Try (Pos : in Positive) return Boolean is function Try (Pos : Positive) return Boolean is
begin begin
Input_Pos := Pos; Input_Pos := Pos;
Last_Paren := 0; Last_Paren := 0;
......
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