Skip to content

R
riscv-gcc-1
Commit 34a343e6 by Robert Dewar Committed by Arnaud Charlet
Options

xeinfo.adb: Remove warnings 

2007-12-06  Robert Dewar  <dewar@adacore.com>

	* xeinfo.adb: Remove warnings
	* xnmake.adb: Remove warnings
	* xsinfo.adb: Remove warnings
	* xtreeprs.adb: Remove warnings
	* xsnames.adb: Remove warnings

	* a-ngcoar.adb: Fix typo.
	* s-interr.adb: Minor reformatting
	* env.c: Minor reformatting.
	* g-bytswa.adb: Minor reformatting.
	* g-rannum.ads: Minor documentation improvements
	* s-tasinf-mingw.adb: Minor header fix
	* a-clrefi.adb: Minor reformatting
	* g-sttsne.ads: Minor documentation improvement
	* g-sttsne-locking.ads: Minor documentation improvement
	* g-soliop-solaris.ads: Minor documentation improvement
	* g-soliop-mingw.ads: Minor documentation improvement
	* g-soliop.ads: Minor documentation improvement
	* exp_aggr.ads: Minor reformatting
	* debug.adb: Add documentation for the gprbuild debug flags
	* exp_ch2.adb: Use Nkind_In to simplify code throughout
	* exp_pakd.adb: Minor reformatting

	* g-altive.ads, g-alleve.adb: Remove assertions.
	Add comment about minor differences between targets regarding
	floating-point operations.

	* g-thread.adb: Remove pragma unreferenced.
	* lib.ads: Minor reformatting
	* par-ch9.adb: Minor reformatting of error messages
	* sem_case.adb: Minor reformatting
	* s-fileio.adb: Minor reformattinng
	* s-vmexta.ads: Minor typo
	* vxaddr2line.adb: 
	Take into account 'Success' value as per new GNAT warning.

From-SVN: r130870
parent 9b998381
Showing with 341 additions and 278 deletions
gcc/ada/a-clrefi.adb
......@@ -51,8 +51,7 @@ package body Ada.Command_Line.Response_File is
type Argument_List_Access is access Argument_List;
procedure Free is new Ada.Unchecked_Deallocation
(Argument_List, Argument_List_Access);
-- Free only the allocated Argument_List, not the allocated String
-- components.
-- Free only the allocated Argument_List, not allocated String components
--------------------
-- Arguments_From --
......@@ -76,8 +75,8 @@ package body Ada.Command_Line.Response_File is
-- if necessary.
procedure Recurse (File_Name : String);
-- Get the arguments from the file and call itself recursively if
-- one of the argument starts with character '@'.
-- Get the arguments from the file and call itself recursively if one of
-- the argument starts with character '@'.
------------------
-- Add_Argument --
......@@ -123,13 +122,13 @@ package body Ada.Command_Line.Response_File is
First_Char : Positive;
-- Index of the first character of an argument in Line
Last_Char : Natural;
Last_Char : Natural;
-- Index of the last character of an argument in Line
In_String : Boolean;
-- True when inside a quoted string
Arg : Positive;
Arg : Positive;
function End_Of_File return Boolean;
-- True when the end of the response file has been reached
......@@ -166,6 +165,7 @@ package body Ada.Command_Line.Response_File is
procedure Get_Line is
Ch : Character;
begin
Last := 0;
......@@ -230,7 +230,6 @@ package body Ada.Command_Line.Response_File is
if FD = Invalid_FD then
if Ignore_Non_Existing_Files then
return;
else
raise File_Does_Not_Exist;
end if;
......@@ -245,9 +244,11 @@ package body Ada.Command_Line.Response_File is
Next => null,
Prev => null);
Last_File := First_File;
else
declare
Current : File_Ptr := First_File;
begin
loop
if Current.Name.all = File_Name then
......@@ -303,10 +304,12 @@ package body Ada.Command_Line.Response_File is
Character_Loop :
while Last_Char <= Last loop
-- Inside a string, check only for '"'
if In_String then
if Line (Last_Char) = '"' then
-- Remove the '"'
Line (Last_Char .. Last - 1) :=
......@@ -314,6 +317,7 @@ package body Ada.Command_Line.Response_File is
Last := Last - 1;
-- End of string is end of argument
if Last_Char > Last or else
Line (Last_Char) = ' ' or else
Line (Last_Char) = ASCII.HT
......@@ -339,6 +343,7 @@ package body Ada.Command_Line.Response_File is
end if;
elsif Last_Char = Last then
-- An opening '"' at the end of the line is an error
if Line (Last) = '"' then
......@@ -351,6 +356,7 @@ package body Ada.Command_Line.Response_File is
end if;
elsif Line (Last_Char) = '"' then
-- Entering a quoted string: remove the '"'
In_String := True;
......@@ -359,8 +365,7 @@ package body Ada.Command_Line.Response_File is
Last := Last - 1;
else
-- Outside of quoted strings, white space ends the
-- argument.
-- Outside quoted strings, white space ends the argument
exit Character_Loop
when Line (Last_Char + 1) = ' ' or else
......@@ -411,8 +416,8 @@ package body Ada.Command_Line.Response_File is
Last_Arg := Last_Arg - 1;
else
-- Save the current arguments and get those in the
-- new response file.
-- Save the current arguments and get those in the new
-- response file.
declare
Inc_File_Name : constant String :=
......@@ -435,6 +440,7 @@ package body Ada.Command_Line.Response_File is
begin
-- Grow Arguments if it is not large enough
if Arguments'Last < New_Last_Arg then
Last_Arg := Arguments'Last;
Free (Arguments);
......@@ -504,6 +510,7 @@ package body Ada.Command_Line.Response_File is
exception
when others =>
-- When an exception occurs, deallocate everything
Free (Arguments);
......
gcc/ada/a-ngcoar.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2006, Free Software Foundation, Inc. --
-- Copyright (C) 2006-2007, 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- --
......@@ -748,7 +748,7 @@ package body Ada.Numerics.Generic_Complex_Arrays is
begin
if Left'Length (2) /= Right'Length (1) then
raise Constraint_Error with
"incompatible dimensions in matrix-matrix multipication";
"incompatible dimensions in matrix-matrix multiplication";
end if;
gemm (Trans_A => No_Trans'Access,
......
gcc/ada/debug.adb
......@@ -623,14 +623,11 @@ package body Debug is
-- dx Force the binder to read (and then ignore) the xref information
-- in ali files (used to check that read circuit is working OK).
------------------------------------------------------------
-- Documentation for the Debug Flags used in package Make --
------------------------------------------------------------
-- Please note that such flags apply to all of Make clients,
-- such as gnatmake.
--------------------------------------------
-- Documentation for gnatmake Debug Flags --
--------------------------------------------
-- dn Do not delete temporary files creates by Make at the end
-- dn Do not delete temporary files created by gnatmake at the end
-- of execution, such as temporary config pragma files, mapping
-- files or project path files.
......@@ -650,6 +647,18 @@ package body Debug is
-- dw Prints the list of units withed by the unit currently explored
-- during the main loop of Make.Compile_Sources.
---------------------------------------------
-- Documentation for gprbuild Debug Flags --
---------------------------------------------
-- dn Do not delete temporary files createed by gprbuild at the end
-- of execution, such as temporary config pragma files, mapping
-- files or project path files.
-- dt When a time stamp mismatch has been found for an ALI file,
-- display the source file name, the time stamp expected and
-- the time stamp found.
--------------------
-- Set_Debug_Flag --
--------------------
......
gcc/ada/env.c
......@@ -177,11 +177,12 @@ __gnat_setenv (char *name, char *value)
sprintf (expression, "%s=%s", name, value);
putenv (expression);
#if (defined (__FreeBSD__) && (__FreeBSD__ < 7)) || defined (__APPLE__) \
|| defined (__MINGW32__) ||(defined (__vxworks) && ! defined (__RTP__))
/* On some systems like pre-7 FreeBSD, MacOS X and Windows, putenv is making
a copy of the expression string so we can free it after the call to
putenv */
#if (defined (__FreeBSD__) && (__FreeBSD__ < 7)) \
|| defined (__APPLE__) || defined (__MINGW32__) \
||(defined (__vxworks) && ! defined (__RTP__))
/* On some systems like FreeBSD 6.x and earlier, MacOS X and Windows,
putenv is making a copy of the expression string so we can free
it after the call to putenv */
free (expression);
#endif
#endif
......
gcc/ada/exp_aggr.ads
......@@ -40,9 +40,9 @@ package Exp_Aggr is
-- This procedure performs in-place aggregate assignment.
procedure Convert_Aggr_In_Allocator
(Alloc : Node_Id;
Decl : Node_Id;
Aggr : Node_Id);
(Alloc : Node_Id;
Decl : Node_Id;
Aggr : Node_Id);
-- Alloc is the allocator whose expression is the aggregate Aggr.
-- Decl is an N_Object_Declaration created during allocator expansion.
-- This procedure perform in-place aggregate assignment into the
......
gcc/ada/exp_ch2.adb
......@@ -433,11 +433,10 @@ package body Exp_Ch2 is
-- ??? passing a formal as actual for a mode IN formal is
-- considered as an assignment?
if Nkind (Parent (N)) = N_Procedure_Call_Statement
or else Nkind (Parent (N)) = N_Entry_Call_Statement
or else
(Nkind (Parent (N)) = N_Assignment_Statement
and then N = Name (Parent (N)))
if Nkind_In (Parent (N), N_Procedure_Call_Statement,
N_Entry_Call_Statement)
or else (Nkind (Parent (N)) = N_Assignment_Statement
and then N = Name (Parent (N)))
then
return True;
......@@ -451,9 +450,9 @@ package body Exp_Ch2 is
-- which case there is an implicit dereference, and the formal itself
-- is not being assigned to).
elsif (Nkind (Parent (N)) = N_Selected_Component
or else Nkind (Parent (N)) = N_Indexed_Component
or else Nkind (Parent (N)) = N_Slice)
elsif Nkind_In (Parent (N), N_Selected_Component,
N_Indexed_Component,
N_Slice)
and then N = Prefix (Parent (N))
and then not Is_Access_Type (Etype (N))
and then In_Assignment_Context (Parent (N))
......@@ -697,7 +696,7 @@ package body Exp_Ch2 is
begin
-- Simple reference case
if Nkind (N) = N_Identifier or else Nkind (N) = N_Expanded_Name then
if Nkind_In (N, N_Identifier, N_Expanded_Name) then
if Is_Formal (Entity (N)) then
return Entity (N);
......
gcc/ada/exp_pakd.adb
......@@ -635,8 +635,8 @@ package body Exp_Pakd is
Attribute_Name => Name_Pos,
Expressions => New_List (
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Styp, Loc),
Attribute_Name => Name_First)))));
Prefix => New_Occurrence_Of (Styp, Loc),
Attribute_Name => Name_First)))));
end if;
Set_Paren_Count (Newsub, 1);
......@@ -960,23 +960,23 @@ package body Exp_Pakd is
Make_Range (Loc,
Low_Bound =>
Make_Attribute_Reference (Loc,
Prefix =>
Prefix =>
New_Occurrence_Of (Indx_Typ, Loc),
Attribute_Name => Name_Pos,
Expressions => New_List (
Expressions => New_List (
Make_Attribute_Reference (Loc,
Prefix =>
Prefix =>
New_Occurrence_Of (Indx_Typ, Loc),
Attribute_Name => Name_First))),
High_Bound =>
Make_Attribute_Reference (Loc,
Prefix =>
Prefix =>
New_Occurrence_Of (Indx_Typ, Loc),
Attribute_Name => Name_Pos,
Expressions => New_List (
Expressions => New_List (
Make_Attribute_Reference (Loc,
Prefix =>
Prefix =>
New_Occurrence_Of (Indx_Typ, Loc),
Attribute_Name => Name_Last)))))));
......@@ -1622,8 +1622,8 @@ package body Exp_Pakd is
Name => New_Occurrence_Of (Set_nn, Loc),
Parameter_Associations => New_List (
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Address,
Prefix => Obj),
Prefix => Obj,
Attribute_Name => Name_Address),
Subscr,
Unchecked_Convert_To (Bits_nn,
Convert_To (Ctyp, Rhs)))));
......@@ -1881,36 +1881,38 @@ package body Exp_Pakd is
Parameter_Associations => New_List (
Make_Byte_Aligned_Attribute_Reference (Loc,
Attribute_Name => Name_Address,
Prefix => L),
Prefix => L,
Attribute_Name => Name_Address),
Make_Op_Multiply (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Prefix =>
Prefix =>
New_Occurrence_Of
(Etype (First_Index (Ltyp)), Loc),
Attribute_Name => Name_Range_Length),
Right_Opnd =>
Make_Integer_Literal (Loc, Component_Size (Ltyp))),
Make_Byte_Aligned_Attribute_Reference (Loc,
Attribute_Name => Name_Address,
Prefix => R),
Prefix => R,
Attribute_Name => Name_Address),
Make_Op_Multiply (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Prefix =>
Prefix =>
New_Occurrence_Of
(Etype (First_Index (Rtyp)), Loc),
Attribute_Name => Name_Range_Length),
Right_Opnd =>
Make_Integer_Literal (Loc, Component_Size (Rtyp))),
Make_Byte_Aligned_Attribute_Reference (Loc,
Attribute_Name => Name_Address,
Prefix => New_Occurrence_Of (Result_Ent, Loc))))));
Prefix => New_Occurrence_Of (Result_Ent, Loc),
Attribute_Name => Name_Address)))));
Rewrite (N,
New_Occurrence_Of (Result_Ent, Loc));
......@@ -2032,8 +2034,8 @@ package body Exp_Pakd is
Name => New_Occurrence_Of (Get_nn, Loc),
Parameter_Associations => New_List (
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Address,
Prefix => Obj),
Prefix => Obj,
Attribute_Name => Name_Address),
Subscr))));
end;
end if;
......@@ -2074,8 +2076,8 @@ package body Exp_Pakd is
Make_Op_Multiply (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Length,
Prefix => New_Occurrence_Of (Ltyp, Loc)),
Prefix => New_Occurrence_Of (Ltyp, Loc),
Attribute_Name => Name_Length),
Right_Opnd =>
Make_Integer_Literal (Loc, Component_Size (Ltyp)));
......@@ -2083,8 +2085,8 @@ package body Exp_Pakd is
Make_Op_Multiply (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Length,
Prefix => New_Occurrence_Of (Rtyp, Loc)),
Prefix => New_Occurrence_Of (Rtyp, Loc),
Attribute_Name => Name_Length),
Right_Opnd =>
Make_Integer_Literal (Loc, Component_Size (Rtyp)));
......@@ -2125,14 +2127,14 @@ package body Exp_Pakd is
Name => New_Occurrence_Of (RTE (RE_Bit_Eq), Loc),
Parameter_Associations => New_List (
Make_Byte_Aligned_Attribute_Reference (Loc,
Attribute_Name => Name_Address,
Prefix => L),
Prefix => L,
Attribute_Name => Name_Address),
LLexpr,
Make_Byte_Aligned_Attribute_Reference (Loc,
Attribute_Name => Name_Address,
Prefix => R),
Prefix => R,
Attribute_Name => Name_Address),
RLexpr)));
end if;
......@@ -2244,22 +2246,23 @@ package body Exp_Pakd is
Parameter_Associations => New_List (
Make_Byte_Aligned_Attribute_Reference (Loc,
Attribute_Name => Name_Address,
Prefix => Opnd),
Prefix => Opnd,
Attribute_Name => Name_Address),
Make_Op_Multiply (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Prefix =>
Prefix =>
New_Occurrence_Of
(Etype (First_Index (Rtyp)), Loc),
Attribute_Name => Name_Range_Length),
Right_Opnd =>
Make_Integer_Literal (Loc, Component_Size (Rtyp))),
Make_Byte_Aligned_Attribute_Reference (Loc,
Attribute_Name => Name_Address,
Prefix => New_Occurrence_Of (Result_Ent, Loc))))));
Prefix => New_Occurrence_Of (Result_Ent, Loc),
Attribute_Name => Name_Address)))));
Rewrite (N,
New_Occurrence_Of (Result_Ent, Loc));
......
gcc/ada/g-alleve.adb
......@@ -7,7 +7,7 @@
-- B o d y --
-- (Soft Binding Version) --
-- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2007, 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- --
......@@ -49,17 +49,6 @@ with GNAT.Altivec.Low_Level_Interface; use GNAT.Altivec.Low_Level_Interface;
package body GNAT.Altivec.Low_Level_Vectors is
-- This package assumes C_float is an IEEE single-precision float type
pragma Assert (C_float'Machine_Radix = 2);
pragma Assert (C_float'Machine_Mantissa = 24);
pragma Assert (C_float'Machine_Emin = -125);
pragma Assert (C_float'Machine_Emax = 128);
pragma Assert (C_float'Machine_Rounds);
pragma Assert (not C_float'Machine_Overflows);
pragma Assert (C_float'Signed_Zeros);
pragma Assert (C_float'Denorm);
-- Pixel types. As defined in [PIM-2.1 Data types]:
-- A 16-bit pixel is 1/5/5/5;
-- A 32-bit pixel is 8/8/8/8.
......
gcc/ada/g-altive.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2007, 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- --
......@@ -341,6 +341,14 @@ package GNAT.Altivec is
type C_float is digits FLOAT_DIGIT range FLOAT_MIN .. FLOAT_MAX;
for C_float'Size use FLOAT_BIT;
-- Altivec operations always use the standard native floating-point
-- support of the target. Note that this means that there may be
-- minor differences in results between targets when the floating-
-- point implementations are slightly different, as would happen
-- with normal non-altivec floating-point operations. In particular
-- the Altivec simulations may yield slightly different results
-- from those obtained on a true hardware Altivec target if the
-- floating-point implementation is not 100% compatible.
----------------------
-- pixel components --
......
gcc/ada/g-bytswa.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2006-2007, AdaCore -- --
-- Copyright (C) 2006-2007, AdaCore --
-- --
-- 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- --
......
gcc/ada/g-rannum.ads
......@@ -33,22 +33,21 @@
-- Extended pseudo-random number generation
-- This package provides a type representing pseudo-random number
-- generators, and subprograms to extract various distributions of numbers
-- from them. It also provides types for representing initialization values
-- and snapshots of internal generator state, which permit reproducible
-- pseudo-random streams.
-- This package provides a type representing pseudo-random number generators,
-- and subprograms to extract various distributions of numbers from them. It
-- also provides types for representing initialization values and snapshots of
-- internal generator state, which permit reproducible pseudo-random streams.
-- The generator currently provided by this package has an extremely long
-- period (at least 2**19937-1), and passes the Big Crush test suite, with
-- the exception of the two linear complexity tests. Therefore, it is
-- suitable for simulations, but should not be used as a cryptographic
-- pseudo-random source without additional processing.
-- The design of this package effects some simplification from that of
-- the standard Ada.Numerics packages. There is no separate State type;
-- the Generator type itself suffices for this purpose. The parameter
-- modes on Reset procedures better reflect the effect of these routines.
-- period (at least 2**19937-1), and passes the Big Crush test suite, with the
-- exception of the two linear complexity tests. Therefore, it is suitable for
-- simulations, but should not be used as a cryptographic pseudo-random source
-- without additional processing.
-- The design of this package effects is simplified compared to the design
-- of standard Ada.Numerics packages. There is no separate State type; the
-- Generator type itself suffices for this purpose. The parameter modes on
-- Reset procedures better reflect the effect of these routines.
with System.Random_Numbers;
with Interfaces; use Interfaces;
......
gcc/ada/g-soliop-mingw.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2006, AdaCore --
-- Copyright (C) 2001-2007, AdaCore --
-- --
-- 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- --
......@@ -36,6 +36,8 @@
-- This is the Windows/NT version of this package
-- This package should not be directly with'ed by an application program
package GNAT.Sockets.Linker_Options is
private
pragma Linker_Options ("-lws2_32");
......
gcc/ada/g-soliop-solaris.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2005, AdaCore --
-- Copyright (C) 2001-2007, AdaCore --
-- --
-- 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- --
......@@ -36,6 +36,8 @@
-- This is the Solaris version of this package
-- This package should not be directly with'ed by an application program
package GNAT.Sockets.Linker_Options is
private
pragma Linker_Options ("-lnsl");
......
gcc/ada/g-soliop.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2005, AdaCore --
-- Copyright (C) 2001-2007, AdaCore --
-- --
-- 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- --
......@@ -38,5 +38,7 @@
-- are required. On some targets a target specific version of this unit
-- ensures linking with required libraries for proper sockets operation.
-- This package should not be directly with'ed by an application program
package GNAT.Sockets.Linker_Options is
end GNAT.Sockets.Linker_Options;
gcc/ada/g-sttsne-locking.ads
......@@ -34,6 +34,8 @@
-- This version is used on VMS, LynxOS, and VxWorks. There are two versions of
-- the body: one for VMS and LynxOS, the other for VxWorks.
-- This package should not be directly with'ed by an application
package GNAT.Sockets.Thin.Task_Safe_NetDB is
----------------------------------------
......
gcc/ada/g-sttsne.ads
......@@ -36,6 +36,8 @@
-- from C; see gsocket.h for details. Different versions are provided on
-- platforms where this functionality is implemented in Ada.
-- This package should not be directly with'ed by an application
package GNAT.Sockets.Thin.Task_Safe_NetDB is
----------------------------------------
......
gcc/ada/g-thread.adb
......@@ -68,7 +68,6 @@ package body GNAT.Threads is
Parm : Void_Ptr;
Code : Code_Proc)
is
pragma Unreferenced (Parm);
pragma Priority (Prio);
pragma Storage_Size (Stsz);
end Thread;
......
gcc/ada/lib.ads
......@@ -208,10 +208,10 @@ package Lib is
-- Special Handling of Subprogram Bodies --
-------------------------------------------
-- A subprogram body (in an adb file) may stand for both a spec and a
-- body. A simple model (and one that was adopted through version 2.07),
-- is simply to assume that such an adb file acts as its own spec if no
-- ads file is present.
-- A subprogram body (in an adb file) may stand for both a spec and a body.
-- A simple model (and one that was adopted through version 2.07) is simply
-- to assume that such an adb file acts as its own spec if no ads file is
-- is present.
-- However, this is not correct. RM 10.1.4(4) requires that such a body
-- act as a spec unless a subprogram declaration of the same name is
......
gcc/ada/par-ch9.adb
......@@ -610,7 +610,7 @@ package body Ch9 is
if (Is_Overriding or else Not_Overriding) then
if Ada_Version < Ada_05 then
Error_Msg_SP (" overriding indicator is an Ada 2005 extension");
Error_Msg_SP ("overriding indicator is an Ada 2005 extension");
Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
elsif Token = Tok_Entry then
......@@ -786,7 +786,7 @@ package body Ch9 is
if (Is_Overriding or else Not_Overriding) then
if Ada_Version < Ada_05 then
Error_Msg_SP (" overriding indicator is an Ada 2005 extension");
Error_Msg_SP ("overriding indicator is an Ada 2005 extension");
Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
elsif Token /= Tok_Entry then
......
gcc/ada/s-fileio.adb
......@@ -1080,7 +1080,7 @@ package body System.File_IO is
if File.Shared_Status = Yes
or else File.Name'Length <= 1
or else File.Is_System_File
or else (not File.Is_Regular_File)
or else not File.Is_Regular_File
then
raise Use_Error;
......
gcc/ada/s-interr.adb
......@@ -140,9 +140,8 @@ package body System.Interrupts is
-- Local Tasks --
-----------------
-- WARNING: System.Tasking.Stages performs calls to this task
-- with low-level constructs. Do not change this spec without synchro-
-- nizing it.
-- WARNING: System.Tasking.Stages performs calls to this task with
-- low-level constructs. Do not change this spec without synchronizing it.
task Interrupt_Manager is
entry Detach_Interrupt_Entries (T : Task_Id);
......@@ -183,10 +182,10 @@ package body System.Interrupts is
task type Server_Task (Interrupt : Interrupt_ID) is
pragma Priority (System.Interrupt_Priority'Last);
-- Note: the above pragma Priority is strictly speaking improper
-- since it is outside the range of allowed priorities, but the
-- compiler treats system units specially and does not apply
-- this range checking rule to system units.
-- Note: the above pragma Priority is strictly speaking improper since
-- it is outside the range of allowed priorities, but the compiler
-- treats system units specially and does not apply this range checking
-- rule to system units.
end Server_Task;
......@@ -210,9 +209,9 @@ package body System.Interrupts is
(others => (null, Static => False));
pragma Volatile_Components (User_Handler);
-- Holds the protected procedure handler (if any) and its Static
-- information for each interrupt. A handler is a Static one if
-- it is specified through the pragma Attach_Handler.
-- Attach_Handler. Otherwise, not static)
-- information for each interrupt. A handler is a Static one if it is
-- specified through the pragma Attach_Handler. Attach_Handler. Otherwise,
-- not static)
User_Entry : array (Interrupt_ID'Range) of Entry_Assoc :=
(others => (T => Null_Task, E => Null_Task_Entry));
......@@ -230,16 +229,16 @@ package body System.Interrupts is
Last_Unblocker :
array (Interrupt_ID'Range) of Task_Id := (others => Null_Task);
pragma Atomic_Components (Last_Unblocker);
-- Holds the ID of the last Task which Unblocked this Interrupt.
-- It contains Null_Task if no tasks have ever requested the
-- Unblocking operation or the Interrupt is currently Blocked.
-- Holds the ID of the last Task which Unblocked this Interrupt. It
-- contains Null_Task if no tasks have ever requested the Unblocking
-- operation or the Interrupt is currently Blocked.
Server_ID : array (Interrupt_ID'Range) of Task_Id :=
(others => Null_Task);
pragma Atomic_Components (Server_ID);
-- Holds the Task_Id of the Server_Task for each interrupt.
-- Task_Id is needed to accomplish locking per Interrupt base. Also
-- is needed to decide whether to create a new Server_Task.
-- Holds the Task_Id of the Server_Task for each interrupt. Task_Id is
-- needed to accomplish locking per Interrupt base. Also is needed to
-- decide whether to create a new Server_Task.
-- Type and Head, Tail of the list containing Registered Interrupt
-- Handlers. These definitions are used to register the handlers
......@@ -264,20 +263,20 @@ package body System.Interrupts is
-----------------------
function Is_Registered (Handler : Parameterless_Handler) return Boolean;
-- See if the Handler has been "pragma"ed using Interrupt_Handler.
-- Always consider a null handler as registered.
-- See if the Handler has been "pragma"ed using Interrupt_Handler. Always
-- consider a null handler as registered.
--------------------
-- Attach_Handler --
--------------------
-- Calling this procedure with New_Handler = null and Static = True
-- means we want to detach the current handler regardless of the
-- previous handler's binding status (ie. do not care if it is a
-- dynamic or static handler).
-- Calling this procedure with New_Handler = null and Static = True means
-- we want to detach the current handler regardless of the previous
-- handler's binding status (ie. do not care if it is a dynamic or static
-- handler).
-- This option is needed so that during the finalization of a PO, we
-- can detach handlers attached through pragma Attach_Handler.
-- This option is needed so that during the finalization of a PO, we can
-- detach handlers attached through pragma Attach_Handler.
procedure Attach_Handler
(New_Handler : Parameterless_Handler;
......@@ -298,8 +297,8 @@ package body System.Interrupts is
-- Bind_Interrupt_To_Entry --
-----------------------------
-- This procedure raises a Program_Error if it tries to bind an
-- interrupt to which an Entry or a Procedure is already bound.
-- This procedure raises a Program_Error if it tries to bind an interrupt
-- to which an Entry or a Procedure is already bound.
procedure Bind_Interrupt_To_Entry
(T : Task_Id;
......@@ -389,13 +388,13 @@ package body System.Interrupts is
-- Exchange_Handler --
----------------------
-- Calling this procedure with New_Handler = null and Static = True
-- means we want to detach the current handler regardless of the
-- previous handler's binding status (ie. do not care if it is a
-- dynamic or static handler).
-- Calling this procedure with New_Handler = null and Static = True means
-- we want to detach the current handler regardless of the previous
-- handler's binding status (ie. do not care if it is a dynamic or static
-- handler).
-- This option is needed so that during the finalization of a PO,
-- we can detach handlers attached through pragma Attach_Handler.
-- This option is needed so that during the finalization of a PO, we can
-- detach handlers attached through pragma Attach_Handler.
procedure Exchange_Handler
(Old_Handler : out Parameterless_Handler;
......
gcc/ada/s-tasinf-mingw.adb
......@@ -4,7 +4,7 @@
-- --
-- S Y S T E M . T A S K _ I N F O --
-- --
-- S p e c --
-- B o d y --
-- --
-- Copyright (C) 2007, Free Software Foundation, Inc. --
-- --
......
gcc/ada/s-vmexta.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2004 Free Software Foundation, Inc. --
-- Copyright (C) 1997-2007, 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- --
......@@ -46,7 +46,7 @@ package System.VMS_Exception_Table is
-- Register an exception in the hash table mapping with a VMS
-- condition code.
-- LOTS more comments needed here regarding the enire scheme ???
-- LOTS more comments needed here regarding the entire scheme ???
private
......
gcc/ada/sem_case.adb
......@@ -756,7 +756,6 @@ package body Sem_Case is
else
Choice := First (Get_Choices (Alt));
while Present (Choice) loop
Analyze (Choice);
Kind := Nkind (Choice);
......
gcc/ada/vxaddr2line.adb
......@@ -458,6 +458,10 @@ begin
Spawn (Addr2line_Cmd.all,
Addr2line_Args (1 .. Addr2line_Args_Count), Success);
if not Success then
Error ("Couldn't spawn " & Addr2line_Cmd.all);
end if;
exception
when others =>
......
gcc/ada/xeinfo.adb
......@@ -63,6 +63,9 @@ procedure XEinfo is
Err : exception;
pragma Warnings (Off);
-- These seem not to be referenced, but they are (by * operator)
A : VString := Nul;
B : VString := Nul;
C : VString := Nul;
......@@ -85,6 +88,8 @@ procedure XEinfo is
Rtn : VString := Nul;
Term : VString := Nul;
pragma Warnings (On);
InB : File_Type;
-- Used to read initial header from body
......@@ -94,41 +99,45 @@ procedure XEinfo is
Ofile : File_Type;
-- Used to write output file
wsp : Pattern := NSpan (' ' & ASCII.HT);
Comment : Pattern := wsp & "--";
For_Rep : Pattern := wsp & "for";
Get_Func : Pattern := wsp * A & "function" & wsp & Break (' ') * Name;
Inline : Pattern := wsp & "pragma Inline (" & Break (')') * Name;
Get_Pack : Pattern := wsp & "package ";
Get_Enam : Pattern := wsp & Break (',') * N & ',';
Find_Fun : Pattern := wsp & "function";
F_Subtyp : Pattern := wsp * A & "subtype " & Break (' ') * N;
G_Subtyp : Pattern := wsp & "subtype" & wsp & Break (' ') * NewS
& wsp & "is" & wsp & Break (" ;") * OldS
& wsp & ';' & wsp & Rtab (0);
F_Typ : Pattern := wsp * A & "type " & Break (' ') * N & " is (";
Get_Nam : Pattern := wsp * A & Break (",)") * Nam & Len (1) * Term;
Get_Styp : Pattern := wsp * A & "subtype " & Break (' ') * N;
Get_N1 : Pattern := wsp & Break (' ') * N1;
Get_N2 : Pattern := wsp & "-- " & Rest * N2;
Get_N3 : Pattern := wsp & Break (';') * N3;
Get_FN : Pattern := wsp * C & "function" & wsp & Break (" (") * FN;
Is_Rturn : Pattern := BreakX ('r') & "return";
Is_Begin : Pattern := wsp & "begin";
Get_Asrt : Pattern := wsp & "pragma Assert";
Semicoln : Pattern := BreakX (';');
Get_Cmnt : Pattern := BreakX ('-') * A & "--";
Get_Expr : Pattern := wsp & "return " & Break (';') * Expr;
Chek_End : Pattern := wsp & "end" & BreakX (';') & ';';
Get_B1 : Pattern := BreakX (' ') * A & " in " & Rest * B;
Get_B2 : Pattern := BreakX (' ') * A & " = " & Rest * B;
Get_B3 : Pattern := BreakX (' ') * A & " /= " & Rest * B;
To_Paren : Pattern := wsp * Filler & '(';
Get_Fml : Pattern := Break (" :") * Formal & wsp & ':' & wsp
& BreakX (" );") * Formaltyp;
Nxt_Fml : Pattern := wsp & "; ";
Get_Rtn : Pattern := wsp & "return" & wsp & BreakX (" ;") * Rtn;
Rem_Prn : Pattern := wsp & ')';
wsp : constant Pattern := NSpan (' ' & ASCII.HT);
Comment : constant Pattern := wsp & "--";
For_Rep : constant Pattern := wsp & "for";
Get_Func : constant Pattern := wsp * A & "function" & wsp
& Break (' ') * Name;
Inline : constant Pattern := wsp & "pragma Inline (" & Break (')') * Name;
Get_Pack : constant Pattern := wsp & "package ";
Get_Enam : constant Pattern := wsp & Break (',') * N & ',';
Find_Fun : constant Pattern := wsp & "function";
F_Subtyp : constant Pattern := wsp * A & "subtype " & Break (' ') * N;
G_Subtyp : constant Pattern := wsp & "subtype" & wsp & Break (' ') * NewS
& wsp & "is" & wsp & Break (" ;") * OldS
& wsp & ';' & wsp & Rtab (0);
F_Typ : constant Pattern := wsp * A & "type " & Break (' ') * N &
" is (";
Get_Nam : constant Pattern := wsp * A & Break (",)") * Nam
& Len (1) * Term;
Get_Styp : constant Pattern := wsp * A & "subtype " & Break (' ') * N;
Get_N1 : constant Pattern := wsp & Break (' ') * N1;
Get_N2 : constant Pattern := wsp & "-- " & Rest * N2;
Get_N3 : constant Pattern := wsp & Break (';') * N3;
Get_FN : constant Pattern := wsp * C & "function" & wsp
& Break (" (") * FN;
Is_Rturn : constant Pattern := BreakX ('r') & "return";
Is_Begin : constant Pattern := wsp & "begin";
Get_Asrt : constant Pattern := wsp & "pragma Assert";
Semicoln : constant Pattern := BreakX (';');
Get_Cmnt : constant Pattern := BreakX ('-') * A & "--";
Get_Expr : constant Pattern := wsp & "return " & Break (';') * Expr;
Chek_End : constant Pattern := wsp & "end" & BreakX (';') & ';';
Get_B1 : constant Pattern := BreakX (' ') * A & " in " & Rest * B;
Get_B2 : constant Pattern := BreakX (' ') * A & " = " & Rest * B;
Get_B3 : constant Pattern := BreakX (' ') * A & " /= " & Rest * B;
To_Paren : constant Pattern := wsp * Filler & '(';
Get_Fml : constant Pattern := Break (" :") * Formal & wsp & ':' & wsp
& BreakX (" );") * Formaltyp;
Nxt_Fml : constant Pattern := wsp & "; ";
Get_Rtn : constant Pattern := wsp & "return" & wsp & BreakX (" ;") * Rtn;
Rem_Prn : constant Pattern := wsp & ')';
M : Match_Result;
......
gcc/ada/xnmake.adb
......@@ -63,18 +63,21 @@ procedure XNmake is
Err : exception;
-- Raised to terminate execution
A : VString := Nul;
Arg : VString := Nul;
Arg_List : VString := Nul;
Comment : VString := Nul;
Default : VString := Nul;
Field : VString := Nul;
Line : VString := Nul;
Node : VString := Nul;
Op_Name : VString := Nul;
Prevl : VString := Nul;
Synonym : VString := Nul;
X : VString := Nul;
pragma Warnings (Off);
-- The following are modified by * operator
A : VString := Nul;
Arg : VString := Nul;
Arg_List : VString := Nul;
Comment : VString := Nul;
Default : VString := Nul;
Field : VString := Nul;
Line : VString := Nul;
Node : VString := Nul;
Op_Name : VString := Nul;
Prevl : VString := Nul;
Synonym : VString := Nul;
X : VString := Nul;
NWidth : Natural;
......@@ -90,37 +93,43 @@ procedure XNmake is
InS, InT : Ada.Text_IO.File_Type;
OutS, OutB : Sfile;
wsp : Pattern := Span (' ' & ASCII.HT);
wsp : constant Pattern := Span (' ' & ASCII.HT);
Body_Only : Pattern := BreakX (' ') * X & Span (' ') & "-- body only";
Spec_Only : Pattern := BreakX (' ') * X & Span (' ') & "-- spec only";
Body_Only : constant Pattern := BreakX (' ') * X
& Span (' ') & "-- body only";
Spec_Only : constant Pattern := BreakX (' ') * X
& Span (' ') & "-- spec only";
Node_Hdr : Pattern := wsp & "-- N_" & Rest * Node;
Punc : Pattern := BreakX (" .,");
Node_Hdr : constant Pattern := wsp & "-- N_" & Rest * Node;
Punc : constant Pattern := BreakX (" .,");
Binop : Pattern := wsp & "-- plus fields for binary operator";
Unop : Pattern := wsp & "-- plus fields for unary operator";
Syn : Pattern := wsp & "-- " & Break (' ') * Synonym
& " (" & Break (')') * Field & Rest * Comment;
Binop : constant Pattern := wsp
& "-- plus fields for binary operator";
Unop : constant Pattern := wsp
& "-- plus fields for unary operator";
Syn : constant Pattern := wsp & "-- " & Break (' ') * Synonym
& " (" & Break (')') * Field
& Rest * Comment;
Templ : Pattern := BreakX ('T') * A & "T e m p l a t e";
Spec : Pattern := BreakX ('S') * A & "S p e c";
Templ : constant Pattern := BreakX ('T') * A & "T e m p l a t e";
Spec : constant Pattern := BreakX ('S') * A & "S p e c";
Sem_Field : Pattern := BreakX ('-') & "-Sem";
Lib_Field : Pattern := BreakX ('-') & "-Lib";
Sem_Field : constant Pattern := BreakX ('-') & "-Sem";
Lib_Field : constant Pattern := BreakX ('-') & "-Lib";
Get_Field : Pattern := BreakX (Decimal_Digit_Set) * Field;
Get_Field : constant Pattern := BreakX (Decimal_Digit_Set) * Field;
Get_Dflt : Pattern := BreakX ('(') & "(set to "
& Break (" ") * Default & " if";
Get_Dflt : constant Pattern := BreakX ('(') & "(set to "
& Break (" ") * Default & " if";
Next_Arg : Pattern := Break (',') * Arg & ',';
Next_Arg : constant Pattern := Break (',') * Arg & ',';
Op_Node : Pattern := "Op_" & Rest * Op_Name;
Op_Node : constant Pattern := "Op_" & Rest * Op_Name;
Shft_Rot : Pattern := "Shift_" or "Rotate_";
Shft_Rot : constant Pattern := "Shift_" or "Rotate_";
No_Ent : Pattern := "Or_Else" or "And_Then" or "In" or "Not_In";
No_Ent : constant Pattern := "Or_Else" or "And_Then"
or "In" or "Not_In";
M : Match_Result;
......
gcc/ada/xsinfo.adb
......@@ -55,6 +55,9 @@ procedure XSinfo is
Done : exception;
Err : exception;
pragma Warnings (Off);
-- Below variables are referenced using * operator
A : VString := Nul;
Arg : VString := Nul;
Comment : VString := Nul;
......@@ -65,23 +68,26 @@ procedure XSinfo is
Rtn : VString := Nul;
Term : VString := Nul;
pragma Warnings (On);
InS : File_Type;
Ofile : File_Type;
wsp : Pattern := Span (' ' & ASCII.HT);
Wsp_For : Pattern := wsp & "for";
Is_Cmnt : Pattern := wsp & "--";
Typ_Nod : Pattern := wsp * A & "type Node_Kind is";
Get_Nam : Pattern := wsp * A & "N_" & Break (",)") * Nam
& Len (1) * Term;
Sub_Typ : Pattern := wsp * A & "subtype " & Break (' ') * N;
No_Cont : Pattern := wsp & Break (' ') * N1 & " .. " & Break (';') * N2;
Cont_N1 : Pattern := wsp & Break (' ') * N1 & " .." & Rpos (0);
Cont_N2 : Pattern := Span (' ') & Break (';') * N2;
Is_Func : Pattern := wsp * A & "function " & Rest * Nam;
Get_Arg : Pattern := wsp & "(N : " & Break (')') * Arg
& ") return " & Break (';') * Rtn
& ';' & wsp & "--" & wsp & Rest * Comment;
wsp : constant Pattern := Span (' ' & ASCII.HT);
Wsp_For : constant Pattern := wsp & "for";
Is_Cmnt : constant Pattern := wsp & "--";
Typ_Nod : constant Pattern := wsp * A & "type Node_Kind is";
Get_Nam : constant Pattern := wsp * A & "N_" & Break (",)") * Nam
& Len (1) * Term;
Sub_Typ : constant Pattern := wsp * A & "subtype " & Break (' ') * N;
No_Cont : constant Pattern := wsp & Break (' ') * N1
& " .. " & Break (';') * N2;
Cont_N1 : constant Pattern := wsp & Break (' ') * N1 & " .." & Rpos (0);
Cont_N2 : constant Pattern := Span (' ') & Break (';') * N2;
Is_Func : constant Pattern := wsp * A & "function " & Rest * Nam;
Get_Arg : constant Pattern := wsp & "(N : " & Break (')') * Arg
& ") return " & Break (';') * Rtn
& ';' & wsp & "--" & wsp & Rest * Comment;
NKV : Natural;
......
gcc/ada/xsnames.adb
......@@ -47,43 +47,48 @@ procedure XSnames is
InH : File_Type;
OutH : File_Type;
A, B : VString := Nul;
Line : VString := Nul;
Name : VString := Nul;
Name1 : VString := Nul;
Oname : VString := Nul;
Oval : VString := Nul;
Restl : VString := Nul;
pragma Warnings (Off);
-- Variables below are modifed by * operator
Tdigs : Pattern := Any (Decimal_Digit_Set) &
Any (Decimal_Digit_Set) &
Any (Decimal_Digit_Set);
A, B : VString := Nul;
Line : VString := Nul;
Name : VString := Nul;
Name1 : VString := Nul;
Oname : VString := Nul;
Oval : VString := Nul;
Restl : VString := Nul;
Name_Ref : Pattern := Span (' ') * A & Break (' ') * Name
& Span (' ') * B
& ": constant Name_Id := N + " & Tdigs
& ';' & Rest * Restl;
pragma Warnings (On);
Get_Name : Pattern := "Name_" & Rest * Name1;
Tdigs : constant Pattern := Any (Decimal_Digit_Set) &
Any (Decimal_Digit_Set) &
Any (Decimal_Digit_Set);
Chk_Low : Pattern := Pos (0) & Any (Lower_Set) & Rest & Pos (1);
Name_Ref : constant Pattern := Span (' ') * A & Break (' ') * Name
& Span (' ') * B
& ": constant Name_Id := N + " & Tdigs
& ';' & Rest * Restl;
Findu : Pattern := Span ('u') * A;
Get_Name : constant Pattern := "Name_" & Rest * Name1;
Chk_Low : constant Pattern := Pos (0) & Any (Lower_Set) & Rest & Pos (1);
Findu : constant Pattern := Span ('u') * A;
Val : Natural;
Xlate_U_Und : Character_Mapping := To_Mapping ("u", "_");
Xlate_U_Und : constant Character_Mapping := To_Mapping ("u", "_");
M : Match_Result;
type Header_Symbol is (None, Attr, Conv, Prag);
-- A symbol in the header file
-- Prefixes used in the header file
procedure Output_Header_Line (S : Header_Symbol);
-- Output header line
Header_Attr : aliased String := "Attr";
Header_Conv : aliased String := "Convention";
Header_Prag : aliased String := "Pragma";
-- Prefixes used in the header file
type String_Ptr is access all String;
Header_Prefix : constant array (Header_Symbol) of String_Ptr :=
......@@ -94,9 +99,12 @@ procedure XSnames is
-- Patterns used in the spec file
Get_Attr : Pattern := Span (' ') & "Attribute_" & Break (",)") * Name1;
Get_Conv : Pattern := Span (' ') & "Convention_" & Break (",)") * Name1;
Get_Prag : Pattern := Span (' ') & "Pragma_" & Break (",)") * Name1;
Get_Attr : constant Pattern := Span (' ') & "Attribute_"
& Break (",)") * Name1;
Get_Conv : constant Pattern := Span (' ') & "Convention_"
& Break (",)") * Name1;
Get_Prag : constant Pattern := Span (' ') & "Pragma_"
& Break (",)") * Name1;
type Header_Symbol_Counter is array (Header_Symbol) of Natural;
Header_Counter : Header_Symbol_Counter := (0, 0, 0, 0);
......@@ -117,7 +125,7 @@ procedure XSnames is
if Header_Current_Symbol /= S then
declare
Pat : String := "#define " & Header_Prefix (S).all;
Pat : constant String := "#define " & Header_Prefix (S).all;
In_Pat : Boolean := False;
begin
......@@ -129,7 +137,7 @@ procedure XSnames is
Line := Get_Line (InH);
if Match (Line, Pat) then
In_Pat := true;
In_Pat := True;
elsif In_Pat then
Header_Pending_Line := Line;
exit;
......
gcc/ada/xtreeprs.adb
......@@ -59,21 +59,26 @@ procedure XTreeprs is
Err : exception;
-- Raised on fatal error
A : VString := Nul;
Ffield : VString := Nul;
Field : VString := Nul;
Fieldno : VString := Nul;
Flagno : VString := Nul;
Line : VString := Nul;
Name : VString := Nul;
Node : VString := Nul;
Outstring : VString := Nul;
Prefix : VString := Nul;
S : VString := Nul;
S1 : VString := Nul;
Syn : VString := Nul;
Synonym : VString := Nul;
Term : VString := Nul;
pragma Warnings (Off);
-- Following variables are assigned by * operator
A : VString := Nul;
Ffield : VString := Nul;
Field : VString := Nul;
Fieldno : VString := Nul;
Flagno : VString := Nul;
Line : VString := Nul;
Name : VString := Nul;
Node : VString := Nul;
Outstring : VString := Nul;
Prefix : VString := Nul;
S : VString := Nul;
S1 : VString := Nul;
Syn : VString := Nul;
Synonym : VString := Nul;
Term : VString := Nul;
pragma Warnings (On);
subtype Sfile is Ada.Streams.Stream_IO.File_Type;
......@@ -123,19 +128,19 @@ procedure XTreeprs is
Sp : aliased Natural;
-- Space left on line for Pchars output
wsp : Pattern := Span (' ' & ASCII.HT);
Is_Temp : Pattern := BreakX ('T') * A & "T e m p l a t e";
Get_Node : Pattern := wsp & "-- N_" & Rest * Node;
Tst_Punc : Pattern := Break (" ,.");
Get_Syn : Pattern := Span (' ') & "-- " & Break (' ') * Synonym
& " (" & Break (')') * Field;
Brk_Min : Pattern := Break ('-') * Ffield;
Is_Flag : Pattern := "Flag" & Rest * Flagno;
Is_Field : Pattern := Rtab (1) & Len (1) * Fieldno;
Is_Syn : Pattern := wsp & "N_" & Break (",)") * Syn & Len (1) * Term;
Brk_Node : Pattern := Break (' ') * Node & ' ';
Chop_SP : Pattern := Len (Sp'Unrestricted_Access) * S1;
wsp : constant Pattern := Span (' ' & ASCII.HT);
Is_Temp : constant Pattern := BreakX ('T') * A & "T e m p l a t e";
Get_Node : constant Pattern := wsp & "-- N_" & Rest * Node;
Tst_Punc : constant Pattern := Break (" ,.");
Get_Syn : constant Pattern := Span (' ') & "-- " & Break (' ') * Synonym
& " (" & Break (')') * Field;
Brk_Min : constant Pattern := Break ('-') * Ffield;
Is_Flag : constant Pattern := "Flag" & Rest * Flagno;
Is_Field : constant Pattern := Rtab (1) & Len (1) * Fieldno;
Is_Syn : constant Pattern := wsp & "N_" & Break (",)") * Syn
& Len (1) * Term;
Brk_Node : constant Pattern := Break (' ') * Node & ' ';
Chop_SP : constant Pattern := Len (Sp'Unrestricted_Access) * S1;
M : Match_Result;
......
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