Table_Increment => Alloc.SFN_Table_Increment,
Table_Name => "Fname_Dummy_Table");
+ function Has_Internal_Extension (Fname : String) return Boolean;
+ -- True if the extension is ".ads" or ".adb", as is always the case for
+ -- internal/predefined units.
+
function Has_Prefix (X, Prefix : String) return Boolean;
-- True if Prefix is at the beginning of X. For example,
-- Has_Prefix("a-filename.ads", Prefix => "a-") is True.
function Has_Suffix (X, Suffix : String) return Boolean;
-- True if Suffix is at the end of X
- function Has_Internal_Extension (Fname : String) return Boolean;
- -- True if the extension is ".ads" or ".adb", as is always the case for
- -- internal/predefined units.
-
----------------------------
-- Has_Internal_Extension --
----------------------------
function Has_Internal_Extension (Fname : String) return Boolean is
begin
- return Has_Suffix (Fname, Suffix => ".ads")
- or else Has_Suffix (Fname, Suffix => ".adb");
+ return
+ Has_Suffix (Fname, Suffix => ".ads")
+ or else Has_Suffix (Fname, Suffix => ".adb");
end Has_Internal_Extension;
----------------
if X'Length >= Prefix'Length then
declare
Slice : String renames
- X (X'First .. X'First + Prefix'Length - 1);
+ X (X'First .. X'First + Prefix'Length - 1);
begin
return Slice = Prefix;
end;
if X'Length >= Suffix'Length then
declare
Slice : String renames
- X (X'Last - Suffix'Length + 1 .. X'Last);
+ X (X'Last - Suffix'Length + 1 .. X'Last);
begin
return Slice = Suffix;
end;
function Is_Internal_File_Name
(Fname : String;
- Renamings_Included : Boolean := True) return Boolean is
+ Renamings_Included : Boolean := True) return Boolean
+ is
begin
-- Check for internal extensions first, so we don't think (e.g.)
-- "gnat.adc" is internal.
return False;
end if;
- return Is_Predefined_File_Name (Fname, Renamings_Included)
- or else Has_Prefix (Fname, Prefix => "g-")
- or else Has_Prefix (Fname, Prefix => "gnat.ad");
+ return
+ Is_Predefined_File_Name (Fname, Renamings_Included)
+ or else Has_Prefix (Fname, Prefix => "g-")
+ or else Has_Prefix (Fname, Prefix => "gnat.ad");
end Is_Internal_File_Name;
function Is_Internal_File_Name
Renamings_Included : Boolean := True) return Boolean
is
begin
- return Is_Internal_File_Name
- (Get_Name_String (Fname), Renamings_Included);
+ return
+ Is_Internal_File_Name
+ (Get_Name_String (Fname), Renamings_Included);
end Is_Internal_File_Name;
-----------------------------
function Is_Predefined_File_Name
(Fname : String;
- Renamings_Included : Boolean := True) return Boolean is
+ Renamings_Included : Boolean := True) return Boolean
+ is
begin
if not Has_Internal_Extension (Fname) then
return False;
return False;
end if;
- if Has_Prefix (Fname, Prefix => "ada.ad") -- Ada
- or else Has_Prefix (Fname, Prefix => "interfac.ad") -- Interfaces
- or else Has_Prefix (Fname, Prefix => "system.ad") -- System
+ if Has_Prefix (Fname, Prefix => "ada.ad") -- Ada
+ or else Has_Prefix (Fname, Prefix => "interfac.ad") -- Interfaces
+ or else Has_Prefix (Fname, Prefix => "system.ad") -- System
then
return True;
end if;
-- The following are the predefined renamings
- return Has_Prefix (Fname, Prefix => "calendar.ad") -- Calendar
- or else Has_Prefix (Fname, Prefix => "machcode.ad") -- Machine_Code
- or else Has_Prefix (Fname, Prefix => "unchconv.ad")
+ return
+ -- Calendar
+
+ Has_Prefix (Fname, Prefix => "calendar.ad")
+
+ -- Machine_Code
+
+ or else Has_Prefix (Fname, Prefix => "machcode.ad")
+
-- Unchecked_Conversion
- or else Has_Prefix (Fname, Prefix => "unchdeal.ad")
+
+ or else Has_Prefix (Fname, Prefix => "unchconv.ad")
+
-- Unchecked_Deallocation
- or else Has_Prefix (Fname, Prefix => "directio.ad") -- Direct_IO
- or else Has_Prefix (Fname, Prefix => "ioexcept.ad") -- IO_Exceptions
- or else Has_Prefix (Fname, Prefix => "sequenio.ad") -- Sequential_IO
- or else Has_Prefix (Fname, Prefix => "text_io.ad"); -- Text_IO
+
+ or else Has_Prefix (Fname, Prefix => "unchdeal.ad")
+
+ -- Direct_IO
+
+ or else Has_Prefix (Fname, Prefix => "directio.ad")
+
+ -- IO_Exceptions
+
+ or else Has_Prefix (Fname, Prefix => "ioexcept.ad")
+
+ -- Sequential_IO
+
+ or else Has_Prefix (Fname, Prefix => "sequenio.ad")
+
+ -- Text_IO
+
+ or else Has_Prefix (Fname, Prefix => "text_io.ad");
end Is_Predefined_File_Name;
function Is_Predefined_File_Name
Renamings_Included : Boolean := True) return Boolean
is
begin
- return Is_Predefined_File_Name
- (Get_Name_String (Fname), Renamings_Included);
+ return
+ Is_Predefined_File_Name
+ (Get_Name_String (Fname), Renamings_Included);
end Is_Predefined_File_Name;
---------------
-- in fact the bodies ARE present, supplied by these pragmas.
function P_Pragma (Skipping : Boolean := False) return Node_Id is
- Interface_Check_Required : Boolean := False;
- -- Set True if check of pragma INTERFACE is required
-
- Import_Check_Required : Boolean := False;
- -- Set True if check of pragma IMPORT is required
-
- Arg_Count : Nat := 0;
- -- Number of argument associations processed
-
- Identifier_Seen : Boolean := False;
- -- Set True if an identifier is encountered for a pragma argument. Used
- -- to check that there are no more arguments without identifiers.
-
- Prag_Node : Node_Id;
- Prag_Name : Name_Id;
- Semicolon_Loc : Source_Ptr;
- Ident_Node : Node_Id;
- Assoc_Node : Node_Id;
- Result : Node_Id;
-
procedure Skip_Pragma_Semicolon;
-- Skip past semicolon at end of pragma
end if;
end Skip_Pragma_Semicolon;
+ -- Local variables
+
+ Interface_Check_Required : Boolean := False;
+ -- Set True if check of pragma INTERFACE is required
+
+ Import_Check_Required : Boolean := False;
+ -- Set True if check of pragma IMPORT is required
+
+ Arg_Count : Nat := 0;
+ -- Number of argument associations processed
+
+ Identifier_Seen : Boolean := False;
+ -- Set True if an identifier is encountered for a pragma argument. Used
+ -- to check that there are no more arguments without identifiers.
+
+ Assoc_Node : Node_Id;
+ Ident_Node : Node_Id;
+ Prag_Name : Name_Id;
+ Prag_Node : Node_Id;
+ Result : Node_Id;
+ Semicolon_Loc : Source_Ptr;
+
-- Start of processing for P_Pragma
begin
-- Cancel indication of being within a pragma or in particular a Depends
-- pragma.
- Inside_Pragma := False;
Inside_Depends := False;
+ Inside_Pragma := False;
-- Now we have two tasks left, we need to scan out the semicolon
-- following the pragma, and we have to call Par.Prag to process
Skip_Pragma_Semicolon;
return Par.Prag (Prag_Node, Semicolon_Loc);
end if;
+
exception
when Error_Resync =>
Resync_Past_Semicolon;
- Inside_Pragma := False;
+ Inside_Depends := False;
+ Inside_Pragma := False;
return Error;
end P_Pragma;