+2014-01-20 Robert Dewar <dewar@adacore.com>
+
+ * errout.ads, errout.adb: Implement >? >x? >X? sequences in error
+ messages.
+ * sem_ch6.adb (Check_Statement_Sequence): Missing return is an
+ error in GNATprove mode.
+
+2014-01-20 Ed Schonberg <schonberg@adacore.com>
+
+ * par-ch4.adb (Is_Parameterless_Attribute): The Ada2012 attribute
+ reference 'Old takes no parameters, and thus can appear as a
+ prefix of a slice.
+
+2014-01-20 Eric Botcazou <ebotcazou@adacore.com>
+
+ * exp_aggr.adb: Fix minor typos.
+
2014-01-20 Ed Schonberg <schonberg@adacore.com>
* sem_attr.adb (Analyze_Attribute, case 'Constrained): In an
P : Natural; -- Current index;
procedure Set_Msg_Insertion_Warning;
- -- Deal with ? ?? ?x? ?X? insertion sequences
+ -- Deal with ? ?? ?x? ?X? insertion sequences (also < <? <x? <X?). The
+ -- caller has already bumped the pointer past the initial ? or <.
-------------------------------
-- Set_Msg_Insertion_Warning --
when '<' =>
- -- If tagging of messages is enabled, and this is a warning,
- -- then it is treated as being [enabled by default].
+ -- Note: the prescan already set Is_Warning_Msg True if and
+ -- only if Error_Msg_Warn is set to True. If Error_Msg_Warn
+ -- is False, the call to Set_Msg_Insertion_Warning here does
+ -- no harm, since Warning_Msg_Char is ignored in that case.
- if Error_Msg_Warn
- and Warning_Doc_Switch
- then
- Warning_Msg_Char := '?';
- end if;
+ Set_Msg_Insertion_Warning;
when '|' =>
null; -- already dealt with
-- are active (see errout.ads for details). If this switch is False, then
-- these sequences are ignored (i.e. simply equivalent to a single ?). The
-- -gnatw.d switch sets this flag True, -gnatw.D sets this flag False.
- -- Note: always ignored in VMS mode where we do not provide this feature.
-----------------------------------
-- Suppression of Error Messages --
-- Insertion character < (Less Than: conditional warning message)
-- The character < appearing anywhere in a message is used for a
-- conditional error message. If Error_Msg_Warn is True, then the
- -- effect is the same as ? described above. If Error_Msg_Warn is
- -- False, then there is no effect.
+ -- effect is the same as ? described above, and in particular <? and
+ -- <X? have the effect of ?? and ?X? respectively. If Error_Msg_Warn
+ -- is False, then the < <? or <X? sequence is ignored and the message
+ -- is treated as a error rather than a warning.
-- Insertion character A-Z (Upper case letter: Ada reserved word)
-- If two or more upper case letters appear in the message, they are
function Is_Static_Dispatch_Table_Aggregate (N : Node_Id) return Boolean;
-- Returns true if N is an aggregate used to initialize the components
- -- of an statically allocated dispatch table.
+ -- of a statically allocated dispatch table.
function Must_Slide
(Obj_Type : Entity_Id;
-- aggregate
function Has_Mutable_Components (Typ : Entity_Id) return Boolean;
- -- Return true if one of the component is of a discriminated type with
+ -- Return true if one of the components is of a discriminated type with
-- defaults. An aggregate for a type with mutable components must be
-- expanded into individual assignments.
function Backend_Processing_Possible (N : Node_Id) return Boolean;
-- This function checks if array aggregate N can be processed directly
- -- by the backend. If this is the case True is returned.
+ -- by the backend. If this is the case, True is returned.
function Build_Array_Aggr_Code
(N : Node_Id;
-- corresponding to the same dimension have the same bounds.
-- 2. Check for packed array aggregate which can be converted to a
- -- constant so that the aggregate disappeares completely.
+ -- constant so that the aggregate disappears completely.
-- 3. Check case of nested aggregate. Generally nested aggregates are
-- handled during the processing of the parent aggregate.
-- If all aggregate components are compile-time known and the aggregate
-- has been flattened, nothing left to do. The same occurs if the
- -- aggregate is used to initialize the components of an statically
+ -- aggregate is used to initialize the components of a statically
-- allocated dispatch table.
if Compile_Time_Known_Aggregate (N)
-- form, but there are two problems with that circuit:
-- a) It is limited to very small cases due to ill-understood
- -- interations with bootstrapping. That limit is removed by
+ -- interactions with bootstrapping. That limit is removed by
-- use of the No_Implicit_Loops restriction.
-- b) It erroneously ends up with the resulting expressions being
-- set and constants whose expression is such an aggregate, recursively.
function Component_Not_OK_For_Backend return Boolean;
- -- Check for presence of component which makes it impossible for the
+ -- Check for presence of a component which makes it impossible for the
-- backend to process the aggregate, thus requiring the use of a series
-- of assignment statements. Cases checked for are a nested aggregate
-- needing Late_Expansion, the presence of a tagged component which may
function Has_Visible_Private_Ancestor (Id : E) return Boolean;
-- If any ancestor of the current type is private, the aggregate
- -- cannot be built in place. We canot rely on Has_Private_Ancestor,
+ -- cannot be built in place. We cannot rely on Has_Private_Ancestor,
-- because it will not be set when type and its parent are in the
-- same scope, and the parent component needs expansion.
then
Convert_To_Assignments (N, Typ);
- -- If the type involved has any non-bit aligned components, then we are
- -- not sure that the back end can handle this case correctly.
+ -- If the type involved has bit aligned components, then we are not sure
+ -- that the back end can handle this case correctly.
elsif Type_May_Have_Bit_Aligned_Components (Typ) then
Convert_To_Assignments (N, Typ);
- -- In all other cases, build a proper aggregate handlable by gigi
+ -- In all other cases, build a proper aggregate to be handled by gigi
else
if Nkind (N) = N_Aggregate then
-- At this stage we have a suitable aggregate for handling at compile
-- time. The only remaining checks are that the values of expressions
-- in the aggregate are compile-time known (checks are performed by
- -- Get_Component_Val, and that any subtypes or ranges are statically
+ -- Get_Component_Val), and that any subtypes or ranges are statically
-- known.
-- If the aggregate is not fully positional at this stage, then
Attribute_External_Tag => True,
Attribute_Img => True,
Attribute_Loop_Entry => True,
+ Attribute_Old => True,
Attribute_Stub_Type => True,
Attribute_Version => True,
Attribute_Type_Key => True,
-- string or a type. For those attributes, a left parenthesis after
-- the attribute should not be analyzed as the beginning of a parameters
-- list because it may denote a slice operation (X'Img (1 .. 2)) or
- -- a type conversion (X'Class (Y)).
+ -- a type conversion (X'Class (Y)). The Ada2012 attribute 'Old is in
+ -- this category.
-- Note: Loop_Entry is in this list because, although it can take an
-- optional argument (the loop name), we can't distinguish that at parse
if Mode = 'F' then
if not Raise_Exception_Call then
- Error_Msg_N
- ("RETURN statement missing following this statement??!",
- Last_Stm);
- Error_Msg_N
- ("\Program_Error may be raised at run time??!",
- Last_Stm);
+
+ -- In GNATprove mode, it is an error to have a missing return
+
+ if GNATprove_Mode then
+ Error_Msg_N
+ ("RETURN statement missing following this statement!",
+ Last_Stm);
+
+ -- Otherwise normal case of warning (RM insists this is legal)
+
+ else
+ Error_Msg_N
+ ("RETURN statement missing following this statement??!",
+ Last_Stm);
+ Error_Msg_N
+ ("\Program_Error may be raised at run time??!",
+ Last_Stm);
+ end if;
end if;
-- Note: we set Err even though we have not issued a warning
projects / thirdparty / gcc.git / commitdiff
