[multiple changes]

2011-08-05  Thomas Quinot  <quinot@adacore.com>

	* sem_ch11.adb: Add comment.

2011-08-05  Robert Dewar  <dewar@adacore.com>

	* exp_util.adb: Minor comment fix.

2011-08-05  Robert Dewar  <dewar@adacore.com>

	* scng.adb (Error_Unterminated_String): Improve flag position when
	comma present.

2011-08-05  Matthew Heaney  <heaney@adacore.com>

	* Makefile.rtl, impunit.adb: Added a-cbmutr.ad[sb] (bounded multiway
	tree containers).
	* a-cbmutr.ads, a-cbmutr.adb: This is the new Ada 2012 unit for bounded
	multiway tree containers.

2011-08-05  Robert Dewar  <dewar@adacore.com>

	* styleg.adb (Check_Comment): Implement comment spacing of 1 or 2
	* stylesw.adb: Implement -gnatyC to control comment spacing
	* stylesw.ads (Style_Check_Comments_Spacing): New switch (set by
	-gnatyc/C).
	* usage.adb: Add line for -gnatyC.

2011-08-05  Robert Dewar  <dewar@adacore.com>

	* gnat_ugn.texi: Document -gnatyC for J505-006
	* vms_data.ads: Implement COMMENTS1/COMMENTS2 (retaining COMMENTS as a
	synonym for COMMENTS2).

From-SVN: r177453
This commit is contained in:
Arnaud Charlet 2011-08-05 17:17:37 +02:00
parent aca0b0b315
commit a2773bd3e6
14 changed files with 3488 additions and 28 deletions

View File

@ -1,3 +1,37 @@
2011-08-05 Thomas Quinot <quinot@adacore.com>
* sem_ch11.adb: Add comment.
2011-08-05 Robert Dewar <dewar@adacore.com>
* exp_util.adb: Minor comment fix.
2011-08-05 Robert Dewar <dewar@adacore.com>
* scng.adb (Error_Unterminated_String): Improve flag position when
comma present.
2011-08-05 Matthew Heaney <heaney@adacore.com>
* Makefile.rtl, impunit.adb: Added a-cbmutr.ad[sb] (bounded multiway
tree containers).
* a-cbmutr.ads, a-cbmutr.adb: This is the new Ada 2012 unit for bounded
multiway tree containers.
2011-08-05 Robert Dewar <dewar@adacore.com>
* styleg.adb (Check_Comment): Implement comment spacing of 1 or 2
* stylesw.adb: Implement -gnatyC to control comment spacing
* stylesw.ads (Style_Check_Comments_Spacing): New switch (set by
-gnatyc/C).
* usage.adb: Add line for -gnatyC.
2011-08-05 Robert Dewar <dewar@adacore.com>
* gnat_ugn.texi: Document -gnatyC for J505-006
* vms_data.ads: Implement COMMENTS1/COMMENTS2 (retaining COMMENTS as a
synonym for COMMENTS2).
2011-08-05 Robert Dewar <dewar@adacore.com>
* par_sco.adb, sem_ch3.adb, scos.ads, a-iteint.ads, sem_ch12.adb,

View File

@ -90,6 +90,7 @@ GNATRTL_NONTASKING_OBJS= \
a-cbhase$(objext) \
a-cborse$(objext) \
a-cbdlli$(objext) \
a-cbmutr$(objext) \
a-cborma$(objext) \
a-cdlili$(objext) \
a-cfdlli$(objext) \

3042
gcc/ada/a-cbmutr.adb Normal file

File diff suppressed because it is too large Load Diff

321
gcc/ada/a-cbmutr.ads Normal file
View File

@ -0,0 +1,321 @@
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- ADA.CONTAINERS.BOUNDED_MULTIWAY_TREES --
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- apply solely to the contents of the part following the private keyword. --
-- --
-- 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- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
private with Ada.Streams;
generic
type Element_Type is private;
with function "=" (Left, Right : Element_Type) return Boolean is <>;
package Ada.Containers.Bounded_Multiway_Trees is
pragma Pure;
pragma Remote_Types;
type Tree (Capacity : Count_Type) is tagged private;
pragma Preelaborable_Initialization (Tree);
type Cursor is private;
pragma Preelaborable_Initialization (Cursor);
Empty_Tree : constant Tree;
No_Element : constant Cursor;
function Equal_Subtree
(Left_Position : Cursor;
Right_Position : Cursor) return Boolean;
function "=" (Left, Right : Tree) return Boolean;
function Is_Empty (Container : Tree) return Boolean;
function Node_Count (Container : Tree) return Count_Type;
function Subtree_Node_Count (Position : Cursor) return Count_Type;
function Depth (Position : Cursor) return Count_Type;
function Is_Root (Position : Cursor) return Boolean;
function Is_Leaf (Position : Cursor) return Boolean;
function Root (Container : Tree) return Cursor;
procedure Clear (Container : in out Tree);
function Element (Position : Cursor) return Element_Type;
procedure Replace_Element
(Container : in out Tree;
Position : Cursor;
New_Item : Element_Type);
procedure Query_Element
(Position : Cursor;
Process : not null access procedure (Element : Element_Type));
procedure Update_Element
(Container : in out Tree;
Position : Cursor;
Process : not null access procedure (Element : in out Element_Type));
procedure Assign (Target : in out Tree; Source : Tree);
function Copy (Source : Tree; Capacity : Count_Type := 0) return Tree;
procedure Move (Target : in out Tree; Source : in out Tree);
procedure Delete_Leaf
(Container : in out Tree;
Position : in out Cursor);
procedure Delete_Subtree
(Container : in out Tree;
Position : in out Cursor);
procedure Swap
(Container : in out Tree;
I, J : Cursor);
function Find
(Container : Tree;
Item : Element_Type) return Cursor;
-- This version of the AI:
-- 10-06-02 AI05-0136-1/07
-- declares Find_In_Subtree with a Container parameter,
-- but this seems incorrect. We need a ruling from the
-- ARG about whether this really was intended. ???
function Find_In_Subtree
(Container : Tree;
Item : Element_Type;
Position : Cursor) return Cursor;
function Ancestor_Find
(Container : Tree;
Item : Element_Type;
Position : Cursor) return Cursor;
function Contains
(Container : Tree;
Item : Element_Type) return Boolean;
function Has_Element (Position : Cursor) return Boolean;
procedure Iterate
(Container : Tree;
Process : not null access procedure (Position : Cursor));
procedure Iterate_Subtree
(Position : Cursor;
Process : not null access procedure (Position : Cursor));
function Child_Count (Parent : Cursor) return Count_Type;
function Child_Depth (Parent, Child : Cursor) return Count_Type;
procedure Insert_Child
(Container : in out Tree;
Parent : Cursor;
Before : Cursor;
New_Item : Element_Type;
Count : Count_Type := 1);
procedure Insert_Child
(Container : in out Tree;
Parent : Cursor;
Before : Cursor;
New_Item : Element_Type;
Position : out Cursor;
Count : Count_Type := 1);
procedure Insert_Child
(Container : in out Tree;
Parent : Cursor;
Before : Cursor;
Position : out Cursor;
Count : Count_Type := 1);
procedure Prepend_Child
(Container : in out Tree;
Parent : Cursor;
New_Item : Element_Type;
Count : Count_Type := 1);
procedure Append_Child
(Container : in out Tree;
Parent : Cursor;
New_Item : Element_Type;
Count : Count_Type := 1);
procedure Delete_Children
(Container : in out Tree;
Parent : Cursor);
procedure Copy_Subtree
(Target : in out Tree;
Parent : Cursor;
Before : Cursor;
Source : Cursor);
procedure Splice_Subtree
(Target : in out Tree;
Parent : Cursor;
Before : Cursor;
Source : in out Tree;
Position : in out Cursor);
procedure Splice_Subtree
(Container : in out Tree;
Parent : Cursor;
Before : Cursor;
Position : Cursor);
procedure Splice_Children
(Target : in out Tree;
Target_Parent : Cursor;
Before : Cursor;
Source : in out Tree;
Source_Parent : Cursor);
procedure Splice_Children
(Container : in out Tree;
Target_Parent : Cursor;
Before : Cursor;
Source_Parent : Cursor);
function Parent (Position : Cursor) return Cursor;
function First_Child (Parent : Cursor) return Cursor;
function First_Child_Element (Parent : Cursor) return Element_Type;
function Last_Child (Parent : Cursor) return Cursor;
function Last_Child_Element (Parent : Cursor) return Element_Type;
function Next_Sibling (Position : Cursor) return Cursor;
function Previous_Sibling (Position : Cursor) return Cursor;
procedure Next_Sibling (Position : in out Cursor);
procedure Previous_Sibling (Position : in out Cursor);
-- This version of the AI:
-- 10-06-02 AI05-0136-1/07
-- declares Iterate_Children this way:
--
-- procedure Iterate_Children
-- (Container : Tree;
-- Parent : Cursor;
-- Process : not null access procedure (Position : Cursor));
--
-- It seems that the Container parameter is there by mistake, but
-- we need an official ruling from the ARG. ???
procedure Iterate_Children
(Parent : Cursor;
Process : not null access procedure (Position : Cursor));
procedure Reverse_Iterate_Children
(Parent : Cursor;
Process : not null access procedure (Position : Cursor));
private
type Children_Type is record
First : Count_Type'Base;
Last : Count_Type'Base;
end record;
type Tree_Node_Type is record
Parent : Count_Type'Base;
Prev : Count_Type'Base;
Next : Count_Type'Base;
Children : Children_Type;
end record;
type Tree_Node_Array is array (Count_Type range <>) of Tree_Node_Type;
type Element_Array is array (Count_Type range <>) of Element_Type;
type Tree (Capacity : Count_Type) is tagged record
Nodes : Tree_Node_Array (0 .. Capacity) := (others => <>);
Elements : Element_Array (1 .. Capacity) := (others => <>);
Free : Count_Type'Base := -1;
Busy : Integer := 0;
Lock : Integer := 0;
Count : Count_Type := 0;
end record;
use Ada.Streams;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Container : Tree);
for Tree'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Container : out Tree);
for Tree'Read use Read;
type Tree_Access is access all Tree;
for Tree_Access'Storage_Size use 0;
type Cursor is record
Container : Tree_Access;
Node : Count_Type'Base := -1;
end record;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Position : Cursor);
for Cursor'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Position : out Cursor);
for Cursor'Read use Read;
Empty_Tree : constant Tree := Tree'(Capacity => 0, others => <>);
No_Element : constant Cursor := Cursor'(others => <>);
end Ada.Containers.Bounded_Multiway_Trees;

View File

@ -176,14 +176,8 @@ package body Exp_Util is
Ti : Entity_Id;
begin
-- For now, we simply ignore a call where the argument has no type
-- (probably case of unanalyzed condition), or has a type that is not
-- Boolean. This is because this is a pretty marginal piece of
-- functionality, and violations of these rules are likely to be
-- truly marginal (how much code uses Fortran Logical as the barrier
-- to a protected entry?) and we do not want to blow up existing
-- programs. We can change this to an assertion after 3.12a is
-- released ???
-- Defend against a call where the argument has no type, or has a
-- type that is not Boolean. This can occur because of prior errors.
if No (T) or else not Is_Boolean_Type (T) then
return;

View File

@ -6258,8 +6258,8 @@ The use of AND/OR operators is not permitted except in the cases of modular
operands, array operands, and simple stand-alone boolean variables or
boolean constants. In all other cases AND THEN/OR ELSE are required.
@item ^c^COMMENTS^
@emph{Check comments.}
@item ^c^COMMENTS^ (double space)
@emph{Check comments, double space.}
Comments must meet the following set of rules:
@itemize @bullet
@ -6310,6 +6310,11 @@ example:
@end smallexample
@end itemize
@item ^C^COMMENTS1^ (single space)
@emph{Check comments, single space.}
This is identical to @code{^c^COMMENTS} except that only one space
is required following the @code{--} of a comment instead of two.
@item ^d^DOS_LINE_ENDINGS^
@emph{Check no DOS line terminators present.}
All lines must be terminated by a single ASCII.LF

View File

@ -517,6 +517,7 @@ package body Impunit is
"a-coinho", -- Ada.Containers.Indefinite_Holders
"a-comutr", -- Ada.Containers.Multiway_Trees
"a-cimutr", -- Ada.Containers.Indefinite_Multiway_Trees
"a-cbmutr", -- Ada.Containers.Bounded_Multiway_Trees
"a-extiin", -- Ada.Execution_Time.Interrupts
"a-iteint", -- Ada.Iterator_Interfaces

View File

@ -919,6 +919,9 @@ package body Scng is
Err : Boolean;
-- Error flag for Scan_Wide call
String_Start : Source_Ptr;
-- Point to first character of string
procedure Error_Bad_String_Char;
-- Signal bad character in string/character literal. On entry
-- Scan_Ptr points to the improper character encountered during the
@ -966,6 +969,8 @@ package body Scng is
-------------------------------
procedure Error_Unterminated_String is
S : Source_Ptr;
begin
-- An interesting little refinement. Consider the following
-- examples:
@ -973,6 +978,7 @@ package body Scng is
-- A := "this is an unterminated string;
-- A := "this is an unterminated string &
-- P(A, "this is a parameter that didn't get terminated);
-- P("this is a parameter that didn't get terminated, A);
-- We fiddle a little to do slightly better placement in these
-- cases also if there is white space at the end of the line we
@ -1012,6 +1018,8 @@ package body Scng is
return;
end if;
-- Backup over semicolon or right-paren/semicolon sequence
if Source (Scan_Ptr - 1) = ';' then
Scan_Ptr := Scan_Ptr - 1;
Unstore_String_Char;
@ -1022,6 +1030,25 @@ package body Scng is
end if;
end if;
-- See if there is a comma in the string, if so, guess that
-- the first comma terminates the string.
S := String_Start;
while S < Scan_Ptr loop
if Source (S) = ',' then
while Scan_Ptr > S loop
Scan_Ptr := Scan_Ptr - 1;
Unstore_String_Char;
end loop;
exit;
end if;
S := S + 1;
end loop;
-- Now we have adjusted the scan pointer, give message
Error_Msg_S -- CODEFIX
("missing string quote");
end Error_Unterminated_String;
@ -1161,6 +1188,8 @@ package body Scng is
-- quote). The latter case is an error detected by the character
-- literal circuit.
String_Start := Scan_Ptr;
Delimiter := Source (Scan_Ptr);
Accumulate_Checksum (Delimiter);

View File

@ -481,7 +481,10 @@ package body Sem_Ch11 is
-- handler, since this may result in false positives, since
-- the handler may handle the exception and return normally.
-- First find enclosing sequence of statements
-- First find the enclosing handled sequence of statements
-- (note, we could also look for a handler in an outer block
-- but currently we don't, and in that case we'll emit the
-- warning).
Par := N;
loop

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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- --
@ -507,7 +507,9 @@ package body Styleg is
S := Scan_Ptr + 2;
while Source (S) >= ' ' loop
if Source (S) /= '-' then
if Is_Box_Comment then
if Is_Box_Comment
or else Style_Check_Comments_Spacing = 1
then
Error_Space_Required (Scan_Ptr + 2);
else
Error_Msg -- CODEFIX
@ -522,14 +524,17 @@ package body Styleg is
-- If we are followed by a blank, then the comment is OK if the
-- character following this blank is another blank or a format
-- effector.
-- effector, or if the required comment spacing is 1.
elsif Source (Scan_Ptr + 3) <= ' ' then
elsif Source (Scan_Ptr + 3) <= ' '
or else Style_Check_Comments_Spacing = 1
then
return;
-- Here is the case where we only have one blank after the two
-- minus signs, which is an error unless the line ends with two
-- minus signs, the case of a box comment.
-- Here is the case where we only have one blank after the two minus
-- signs, with Style_Check_Comments_Spacing set to 2, which is an
-- error unless the line ends with two minus signs, the case of a
-- box comment.
elsif not Is_Box_Comment then
Error_Space_Required (Scan_Ptr + 3);

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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- --
@ -160,7 +160,13 @@ package body Stylesw is
Add ('A', Style_Check_Array_Attribute_Index);
Add ('b', Style_Check_Blanks_At_End);
Add ('B', Style_Check_Boolean_And_Or);
Add ('c', Style_Check_Comments);
if Style_Check_Comments_Spacing = 2 then
Add ('c', Style_Check_Comments);
elsif Style_Check_Comments_Spacing = 1 then
Add ('C', Style_Check_Comments);
end if;
Add ('d', Style_Check_DOS_Line_Terminator);
Add ('e', Style_Check_End_Labels);
Add ('f', Style_Check_Form_Feeds);
@ -322,6 +328,11 @@ package body Stylesw is
when 'c' =>
Style_Check_Comments := True;
Style_Check_Comments_Spacing := 2;
when 'C' =>
Style_Check_Comments := True;
Style_Check_Comments_Spacing := 1;
when 'd' =>
Style_Check_DOS_Line_Terminator := True;
@ -484,7 +495,7 @@ package body Stylesw is
when 'B' =>
Style_Check_Boolean_And_Or := False;
when 'c' =>
when 'c' | 'C' =>
Style_Check_Comments := False;
when 'd' =>

View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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- --
@ -94,7 +94,8 @@ package Stylesw is
-- The comment characters are followed by an exclamation point (the
-- sequence --! is used by gnatprep for marking deleted lines).
--
-- The comment characters are followed by two space characters
-- The comment characters are followed by two space characters if
-- Comment_Spacing = 2, else by one character if Comment_Spacing = 1.
--
-- The line consists entirely of minus signs
--
@ -104,6 +105,9 @@ package Stylesw is
-- Note: the reason for the last two conditions is to allow "boxed"
-- comments where only a single space separates the comment characters.
Style_Check_Comments_Spacing : Nat range 1 .. 2;
-- Spacing required for comments, valid only if Style_Check_Comments true.
Style_Check_DOS_Line_Terminator : Boolean := False;
-- This can be set true by using the -gnatyd switch. If it is True, then
-- the line terminator must be a single LF, without an associated CR (e.g.

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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- --
@ -548,7 +548,8 @@ begin
Write_Line (" A check array attribute indexes");
Write_Line (" b check no blanks at end of lines");
Write_Line (" B check no use of AND/OR for boolean expressions");
Write_Line (" c check comment format");
Write_Line (" c check comment format (two spaces)");
Write_Line (" C check comment format (one space)");
Write_Line (" d check no DOS line terminators");
Write_Line (" e check end/exit labels present");
Write_Line (" f check no form feeds/vertical tabs in source");

View File

@ -2319,6 +2319,10 @@ package VMS_Data is
"-gnaty-B " &
"COMMENTS " &
"-gnatyc " &
"COMMENTS1 " &
"-gnatyC " &
"COMMENTS2 " &
"-gnatyc " &
"NOCOMMENTS " &
"-gnaty-c " &
"DOS_LINE_ENDINGS " &
@ -2409,7 +2413,7 @@ package VMS_Data is
-- input source code. The following keywords are supported:
--
-- ALL_BUILTIN (D) Equivalent to the following list of options:
-- 3, ATTRIBUTE, BLANKS, COMMENTS, END, VTABS,
-- 3, ATTRIBUTE, BLANKS, COMMENTS2, END, VTABS,
-- HTABS, IF_THEN, KEYWORD, LAYOUT, LINE_LENGTH,
-- PRAGMA, REFERENCES, SPECS, TOKEN.
--
@ -2441,8 +2445,8 @@ package VMS_Data is
-- enforce a canonical format for the use of
-- blanks to separate source tokens.
--
-- COMMENTS Check comments.
-- Comments must meet the following set of rules:
-- COMMENTS2 Check comments.
-- COMMENTS Comments must meet the following set of rules:
--
-- * The "--" that starts the column must either
-- start in column one, or else at least one
@ -2488,6 +2492,11 @@ package VMS_Data is
-- -- This is a box comment --
-- ---------------------------
--
-- COMMENTS1 Check comments (single space).
-- Like COMMENTS2, but the -- of a comment only
-- requires one or more spaces following, instead
-- of two or more spaces.
--
-- DOS_LINE_ENDINGS Check that no DOS line terminators are present
-- All lines must be terminated by a single
-- ASCII.LF character. In particular the DOS line