Skip to content

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

sem_ch3.adb, [...]: Minor reformatting. 

2014-10-17  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb, a-strsea.adb: Minor reformatting.
	* par-ch6.adb (P_Subprogram): Fix bad handling of null procedures.

From-SVN: r216375
parent b98b57a5
Showing with 50 additions and 50 deletions
gcc/ada/ChangeLog
2014-10-17 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, a-strsea.adb: Minor reformatting.
* par-ch6.adb (P_Subprogram): Fix bad handling of null procedures.
2014-10-17 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Build_Derived_Enumeration_Type): Propagate aspect
......
gcc/ada/a-strsea.adb
......@@ -482,7 +482,7 @@ package body Ada.Strings.Search is
is
begin
-- AI05-056 : if source is empty result is always 0.
-- AI05-056: If source is empty result is always zero
if Source'Length = 0 then
return 0;
......@@ -514,7 +514,7 @@ package body Ada.Strings.Search is
is
begin
-- AI05-056 : if source is empty result is always 0.
-- AI05-056: If source is empty result is always zero
if Source'Length = 0 then
return 0;
......
gcc/ada/par-ch6.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
......@@ -938,7 +938,7 @@ package body Ch6 is
Aspects := Get_Aspect_Specifications (Semicolon => False);
-- Aspects may be present on a subprogram body. The source parsed
-- so far is that of its specification, go parse the body and attach
-- so far is that of its specification. Go parse the body and attach
-- the collected aspects, if any, to the body.
if Token = Tok_Is then
......@@ -959,7 +959,14 @@ package body Ch6 is
-- Semicolon Used in Place of IS" in body of Parser package)
-- Note that SIS_Missing_Semicolon_Message is already set properly.
if Pf_Flags.Pbod then
if Pf_Flags.Pbod
-- Disconnnect this processing if we have scanned a null procedure
-- because in this case the spec is complete anyway with no body.
and then (Nkind (Specification_Node) /= N_Procedure_Specification
or else not Null_Present (Specification_Node))
then
SIS_Labl := Scope.Table (Scope.Last).Labl;
SIS_Sloc := Scope.Table (Scope.Last).Sloc;
SIS_Ecol := Scope.Table (Scope.Last).Ecol;
......
gcc/ada/sem_ch3.adb
......@@ -3285,19 +3285,20 @@ package body Sem_Ch3 is
-- Enter_Name will handle the visibility.
or else
(Is_Discriminal (Id)
(Is_Discriminal (Id)
and then Ekind (Discriminal_Link (Id)) =
E_Entry_Index_Parameter)
E_Entry_Index_Parameter)
-- The current object is the renaming for a generic declared
-- within the instance.
or else
(Ekind (Prev_Entity) = E_Package
and then Nkind (Parent (Prev_Entity)) =
N_Package_Renaming_Declaration
and then not Comes_From_Source (Prev_Entity)
and then Is_Generic_Instance (Renamed_Entity (Prev_Entity))))
(Ekind (Prev_Entity) = E_Package
and then Nkind (Parent (Prev_Entity)) =
N_Package_Renaming_Declaration
and then not Comes_From_Source (Prev_Entity)
and then
Is_Generic_Instance (Renamed_Entity (Prev_Entity))))
then
Prev_Entity := Empty;
end if;
......@@ -4236,9 +4237,7 @@ package body Sem_Ch3 is
Parent_Type := Find_Type_Of_Subtype_Indic (Indic);
Parent_Base := Base_Type (Parent_Type);
if Parent_Type = Any_Type
or else Etype (Parent_Type) = Any_Type
then
if Parent_Type = Any_Type or else Etype (Parent_Type) = Any_Type then
Set_Ekind (T, Ekind (Parent_Type));
Set_Etype (T, Any_Type);
goto Leave;
......@@ -6374,9 +6373,9 @@ package body Sem_Ch3 is
-- this right???
if Nkind (Indic) = N_Subtype_Indication then
Apply_Range_Check (Range_Expression (Constraint (Indic)),
Parent_Type,
Source_Typ => Entity (Subtype_Mark (Indic)));
Apply_Range_Check
(Range_Expression (Constraint (Indic)), Parent_Type,
Source_Typ => Entity (Subtype_Mark (Indic)));
end if;
end if;
end Build_Derived_Enumeration_Type;
......@@ -8024,7 +8023,7 @@ package body Sem_Ch3 is
elsif Is_Limited_Record (Parent_Type)
or else (Present (Full_View (Parent_Type))
and then Is_Limited_Record (Full_View (Parent_Type)))
and then Is_Limited_Record (Full_View (Parent_Type)))
then
if not Is_Interface (Parent_Type)
or else Is_Synchronized_Interface (Parent_Type)
......@@ -8210,7 +8209,7 @@ package body Sem_Ch3 is
Set_Is_Constrained
(Derived_Type,
not (Inherit_Discrims
or else Has_Unknown_Discriminants (Derived_Type)));
or else Has_Unknown_Discriminants (Derived_Type)));
end if;
-- STEP 3: initialize fields of derived type
......@@ -8607,7 +8606,7 @@ package body Sem_Ch3 is
-- Set SSO default for record or array type
if (Is_Array_Type (Derived_Type)
or else Is_Record_Type (Derived_Type))
or else Is_Record_Type (Derived_Type))
and then Is_Base_Type (Derived_Type)
then
Set_Default_SSO (Derived_Type);
......@@ -8909,8 +8908,7 @@ package body Sem_Ch3 is
elsif Nkind (Constr) = N_Range
or else (Nkind (Constr) = N_Attribute_Reference
and then
Attribute_Name (Constr) = Name_Range)
and then Attribute_Name (Constr) = Name_Range)
then
Error_Msg_N
("a range is not a valid discriminant constraint", Constr);
......@@ -12181,7 +12179,8 @@ package body Sem_Ch3 is
Get_Index_Bounds (Old_Index, Lo_Expr, Hi_Expr);
if Is_Discriminant (Lo_Expr)
or else Is_Discriminant (Hi_Expr)
or else
Is_Discriminant (Hi_Expr)
then
Need_To_Create_Itype := True;
end if;
......@@ -12401,7 +12400,7 @@ package body Sem_Ch3 is
-- were declared in Typ's private view.
or else (Is_Private_Type (Discrim_Scope)
and then Chars (Discrim_Scope) = Chars (Typ))
and then Chars (Discrim_Scope) = Chars (Typ))
-- or else we are deriving from the full view and the
-- discriminant is declared in the private entity.
......@@ -13371,9 +13370,7 @@ package body Sem_Ch3 is
-- The tag and the possible parent component are unconditionally in
-- the subtype.
if Is_Tagged_Type (Typ)
or else Has_Controlled_Component (Typ)
then
if Is_Tagged_Type (Typ) or else Has_Controlled_Component (Typ) then
Old_C := First_Component (Typ);
while Present (Old_C) loop
if Nam_In (Chars (Old_C), Name_uTag, Name_uParent) then
......@@ -15015,8 +15012,8 @@ package body Sem_Ch3 is
loop
exit when No (Partial_View)
or else (Has_Private_Declaration (Partial_View)
and then
Full_View (Partial_View) = Derived_Type);
and then
Full_View (Partial_View) = Derived_Type);
Next_Entity (Partial_View);
end loop;
......@@ -15373,9 +15370,7 @@ package body Sem_Ch3 is
-- subtype of Any_Type, and set a few attributes to prevent cascaded
-- errors. If this is a self-definition, emit error now.
if T = Parent_Type
or else T = Etype (Parent_Type)
then
if T = Parent_Type or else T = Etype (Parent_Type) then
Error_Msg_N ("type cannot be used in its own definition", Indic);
end if;
......@@ -15858,9 +15853,7 @@ package body Sem_Ch3 is
-- Start of processing for Expand_To_Stored_Constraint
begin
if No (Constraint)
or else Is_Empty_Elmt_List (Constraint)
then
if No (Constraint) or else Is_Empty_Elmt_List (Constraint) then
return No_Elist;
end if;
......@@ -16242,7 +16235,7 @@ package body Sem_Ch3 is
if Is_Type (Prev)
and then (Is_Tagged_Type (Prev)
or else Present (Class_Wide_Type (Prev)))
or else Present (Class_Wide_Type (Prev)))
then
-- Ada 2012 (AI05-0162): A private type may be the completion of
-- an incomplete type.
......@@ -16937,8 +16930,7 @@ package body Sem_Ch3 is
elsif Nkind (C) = N_Digits_Constraint then
return
Is_Decimal_Fixed_Point_Type (Entity (Subtype_Mark (N)))
or else
Present (Range_Constraint (C));
or else Present (Range_Constraint (C));
elsif Nkind (C) = N_Delta_Constraint then
return Present (Range_Constraint (C));
......@@ -17028,7 +17020,7 @@ package body Sem_Ch3 is
-- Start of processing for Inherit_Component
begin
pragma Assert (not Is_Tagged or else not Stored_Discrim);
pragma Assert (not Is_Tagged or not Stored_Discrim);
Set_Parent (New_C, Parent (Old_C));
......@@ -17073,7 +17065,7 @@ package body Sem_Ch3 is
elsif (Is_Private_Type (Derived_Base)
and then not Is_Generic_Type (Derived_Base))
or else (Is_Empty_Elmt_List (Discs)
and then not Expander_Active)
and then not Expander_Active)
then
Set_Etype (New_C, Etype (Old_C));
......@@ -17215,9 +17207,9 @@ package body Sem_Ch3 is
and then Present (First_Discriminant (Derived_Base))
and then
(not Is_Private_Type (Derived_Base)
or else Is_Completely_Hidden
(First_Stored_Discriminant (Derived_Base))
or else Is_Generic_Type (Derived_Base))
or else Is_Completely_Hidden
(First_Stored_Discriminant (Derived_Base))
or else Is_Generic_Type (Derived_Base))
then
D := First_Discriminant (Derived_Base);
while Present (D) loop
......@@ -18779,9 +18771,7 @@ package body Sem_Ch3 is
begin
-- Abstract interfaces are only associated with tagged record types
if not Is_Tagged_Type (Typ)
or else not Is_Record_Type (Typ)
then
if not Is_Tagged_Type (Typ) or else not Is_Record_Type (Typ) then
return;
end if;
......@@ -20488,9 +20478,7 @@ package body Sem_Ch3 is
-- Normal case
if Ada_Version < Ada_2005
or else not Interface_Present (Def)
then
if Ada_Version < Ada_2005 or else not Interface_Present (Def) then
if Limited_Present (Def) then
Check_SPARK_05_Restriction ("limited is not allowed", N);
end if;
......
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