[flang] Extension: reduced scope for some implied DO loop indices

[klausler]

Summary

The index of an implied DO loop in a DATA statement or array
constructor is defined by Fortran 2018 to have scope over its
implied DO loop. This definition is unfortunate, because it
requires the implied DO loop's bounds expressions to be in the
scope of the index variable. Consequently, in code like

integer, parameter :: j = 5
real, save :: a(5) = [(j, j=1, j)]

the upper bound of the loop is a reference to the index variable,
not the parameter in the enclosing scope.

This patch limits the scope of the index variable to the "body"
of the implied DO loop as one would naturally expect, with a warning.
I would have preferred to make this a hard error, but most Fortran
compilers treat this case as f18 now does. If the standard
were to be fixed, the warning could be made optional.

flang/docs/Extensions.md

* Delimited list-directed (and NAMELIST) character output is required
   behavior will change as needed to conform.
 ```
 character(11) :: buffer(3)
 character(10) :: quotes = '""""""""""'
 write(buffer,*,delim="QUOTE") quotes
 print "('>',a10,'<')", buffer
 end
 ```
+* The name of the control variable in an implied DO loop in an array
+  constructor or DATA statement has a scope over the value-list only,
+  not the bounds of the implied DO loop.  It is not advisable to use
+  an object of the same name as the index variable in a bounds
+  expression, but it will work, instead of being needlessly undefined.
 
 ## Extensions, deletions, and legacy features supported by default
 
 * Tabs in source
 * `<>` as synonym for `.NE.` and `/=`
 * `$` and `@` as legal characters in names
 * Initialization in type declaration statements using `/values/`
 * Kind specification with `*`, e.g. `REAL*4`

flang/lib/Semantics/expression.cpp

void ArrayConstructorContext::Add(const parser::AcImpliedDo &impliedDo) {
   const auto &bounds{std::get<parser::AcImpliedDoControl::Bounds>(control.t)};
   exprAnalyzer_.Analyze(bounds.name);
   parser::CharBlock name{bounds.name.thing.thing.source};
   const Symbol *symbol{bounds.name.thing.thing.symbol};
   int kind{ImpliedDoIntType::kind};
   if (const auto dynamicType{DynamicType::From(symbol)}) {
     kind = dynamicType->kind();
   }
-  if (!exprAnalyzer_.AddImpliedDo(name, kind)) {
-    if (!(messageDisplayedSet_ & 0x20)) {
-      exprAnalyzer_.SayAt(name,
-          "Implied DO index is active in surrounding implied DO loop "
-          "and may not have the same name"_err_en_US); // C7115
-      messageDisplayedSet_ |= 0x20;
-    }
-    return;
-  }
   std::optional<Expr<ImpliedDoIntType>> lower{
       GetSpecificIntExpr<ImpliedDoIntType::kind>(bounds.lower)};
   std::optional<Expr<ImpliedDoIntType>> upper{
       GetSpecificIntExpr<ImpliedDoIntType::kind>(bounds.upper)};
   if (lower && upper) {
     std::optional<Expr<ImpliedDoIntType>> stride{
         GetSpecificIntExpr<ImpliedDoIntType::kind>(bounds.step)};
     if (!stride) {
       stride = Expr<ImpliedDoIntType>{1};
     }
+    if (exprAnalyzer_.AddImpliedDo(name, kind)) {
       // Check for constant bounds; the loop may require complete unrolling
       // of the parse tree if all bounds are constant in order to allow the
       // implied DO loop index to qualify as a constant expression.
       auto cLower{ToInt64(lower)};
       auto cUpper{ToInt64(upper)};
       auto cStride{ToInt64(stride)};
       if (!(messageDisplayedSet_ & 0x10) && cStride && *cStride == 0) {
         exprAnalyzer_.SayAt(bounds.step.value().thing.thing.value().source,
             "The stride of an implied DO loop must not be zero"_err_en_US);
         messageDisplayedSet_ |= 0x10;
       }
       bool isConstant{cLower && cUpper && cStride && *cStride != 0};
       bool isNonemptyConstant{isConstant &&
           ((*cStride > 0 && *cLower <= *cUpper) ||
               (*cStride < 0 && *cLower >= *cUpper))};
       bool unrollConstantLoop{false};
       parser::Messages buffer;
       auto saveMessagesDisplayed{messageDisplayedSet_};
       {
         auto messageRestorer{
             exprAnalyzer_.GetContextualMessages().SetMessages(buffer)};
         auto v{std::move(values_)};
         for (const auto &value :
             std::get<std::list<parser::AcValue>>(impliedDo.t)) {
           Add(value);
         }
         std::swap(v, values_);
         if (isNonemptyConstant && buffer.AnyFatalError()) {
           unrollConstantLoop = true;
         } else {
           values_.Push(ImpliedDo<SomeType>{name, std::move(*lower),
               std::move(*upper), std::move(*stride), std::move(v)});
         }
       }
       if (unrollConstantLoop) {
         messageDisplayedSet_ = saveMessagesDisplayed;
         UnrollConstantImpliedDo(impliedDo, name, *cLower, *cUpper, *cStride);
       } else if (auto *messages{
                      exprAnalyzer_.GetContextualMessages().messages()}) {
         messages->Annex(std::move(buffer));
       }
-  }
       exprAnalyzer_.RemoveImpliedDo(name);
+    } else if (!(messageDisplayedSet_ & 0x20)) {
+      exprAnalyzer_.SayAt(name,
+          "Implied DO index '%s' is active in a surrounding implied DO loop "
+          "and may not have the same name"_err_en_US,
+          name); // C7115
+      messageDisplayedSet_ |= 0x20;
+    }
+  }
 }
 
 // Fortran considers an implied DO index of an array constructor to be
 // a constant expression if the bounds of the implied DO loop are constant.
 // Usually this doesn't matter, but if we emitted spurious messages as a
 // result of not using constant values for the index while analyzing the
 // items, we need to do it again the "hard" way with multiple iterations over
 // the parse tree.

flang/lib/Semantics/resolve-names.cpp

protected:
   void EndDecl();
   Symbol &DeclareObjectEntity(const parser::Name &, Attrs = Attrs{});
   // Make sure that there's an entity in an enclosing scope called Name
   Symbol &FindOrDeclareEnclosingEntity(const parser::Name &);
   // Declare a LOCAL/LOCAL_INIT entity. If there isn't a type specified
   // it comes from the entity in the containing scope, or implicit rules.
   // Return pointer to the new symbol, or nullptr on error.
   Symbol *DeclareLocalEntity(const parser::Name &);
-  // Declare a statement entity (e.g., an implied DO loop index).
-  // If there isn't a type specified, implicit rules apply.
-  // Return pointer to the new symbol, or nullptr on error.
-  Symbol *DeclareStatementEntity(
-      const parser::Name &, const std::optional<parser::IntegerTypeSpec> &);
+  // Declare a statement entity (i.e., an implied DO loop index for
+  // a DATA statement or an array constructor).  If there isn't an explict
+  // type specified, implicit rules apply. Return pointer to the new symbol,
+  // or nullptr on error.
+  Symbol *DeclareStatementEntity(const parser::DoVariable &,
+      const std::optional<parser::IntegerTypeSpec> &);
   Symbol &MakeCommonBlockSymbol(const parser::Name &);
   Symbol &MakeCommonBlockSymbol(const std::optional<parser::Name> &);
   bool CheckUseError(const parser::Name &);
   void CheckAccessibility(const SourceName &, bool, Symbol &);
   void CheckCommonBlocks();
   void CheckSaveStmts();
   void CheckEquivalenceSets();
   bool CheckNotInBlock(const char *);
   bool NameIsKnownOrIntrinsic(const parser::Name &);
 
   // Each of these returns a pointer to a resolved Name (i.e. with symbol)
   // or nullptr in case of error.
   const parser::Name *ResolveStructureComponent(
       const parser::StructureComponent &);
   const parser::Name *ResolveDataRef(const parser::DataRef &);
   const parser::Name *ResolveName(const parser::Name &);
   bool PassesSharedLocalityChecks(const parser::Name &name, Symbol &symbol);
   Symbol *NoteInterfaceName(const parser::Name &);
   bool IsUplevelReference(const Symbol &);
 
+  std::optional<SourceName> BeginCheckOnIndexUseInOwnBounds(
+      const parser::DoVariable &name) {
+    std::optional<SourceName> result{checkIndexUseInOwnBounds_};
+    checkIndexUseInOwnBounds_ = name.thing.thing.source;
+    return result;
+  }
+  void EndCheckOnIndexUseInOwnBounds(const std::optional<SourceName> &restore) {
+    checkIndexUseInOwnBounds_ = restore;
+  }
+
 private:
   // The attribute corresponding to the statement containing an ObjectDecl
   std::optional<Attr> objectDeclAttr_;
   // Info about current character type while walking DeclTypeSpec.
   // Also captures any "*length" specifier on an individual declaration.
   struct {
     std::optional<ParamValue> length;
     std::optional<KindExpr> kind;
private:
   std::multimap<Symbol *, const parser::Name *> genericBindings_;
   // Info about current ENUM
   struct EnumeratorState {
     // Enum value must hold inside a C_INT (7.6.2).
     std::optional<int> value{0};
   } enumerationState_;
   // Set for OldParameterStmt processing
   bool inOldStyleParameterStmt_{false};
+  // Set when walking DATA & array constructor implied DO loop bounds
+  // to warn about use of the implied DO intex therein.
+  std::optional<SourceName> checkIndexUseInOwnBounds_;
 
   bool HandleAttributeStmt(Attr, const std::list<parser::Name> &);
   Symbol &HandleAttributeStmt(Attr, const parser::Name &);
   Symbol &DeclareUnknownEntity(const parser::Name &, Attrs);
   Symbol &DeclareProcEntity(const parser::Name &, Attrs, const ProcInterface &);
   void SetType(const parser::Name &, const DeclTypeSpec &);
   std::optional<DerivedTypeSpec> ResolveDerivedType(const parser::Name &);
   std::optional<DerivedTypeSpec> ResolveExtendsType(

 Symbol *DeclarationVisitor::DeclareLocalEntity(const parser::Name &name) {
   Symbol &prev{FindOrDeclareEnclosingEntity(name)};
   if (!PassesLocalityChecks(name, prev)) {
     return nullptr;
   }
   return &MakeHostAssocSymbol(name, prev);
 }
 
-Symbol *DeclarationVisitor::DeclareStatementEntity(const parser::Name &name,
+Symbol *DeclarationVisitor::DeclareStatementEntity(
+    const parser::DoVariable &doVar,
     const std::optional<parser::IntegerTypeSpec> &type) {
+  const parser::Name &name{doVar.thing.thing};
   const DeclTypeSpec *declTypeSpec{nullptr};
   if (auto *prev{FindSymbol(name)}) {
     if (prev->owner() == currScope()) {
       SayAlreadyDeclared(name, *prev);
       return nullptr;
     }
     name.symbol = nullptr;
     declTypeSpec = prev->GetType();
if (declTypeSpec) {
     // Subtlety: Don't let a "*length" specifier (if any is pending) affect the
     // declaration of this implied DO loop control variable.
     auto restorer{
         common::ScopedSet(charInfo_.length, std::optional<ParamValue>{})};
     SetType(name, *declTypeSpec);
   } else {
     ApplyImplicitRules(symbol);
   }
-  return Resolve(name, &symbol);
+  Symbol *result{Resolve(name, &symbol)};
+  AnalyzeExpr(context(), doVar); // enforce INTEGER type
+  return result;
 }
 
 // Set the type of an entity or report an error.
 void DeclarationVisitor::SetType(
     const parser::Name &name, const DeclTypeSpec &type) {
   CHECK(name.symbol);
   auto &symbol{*name.symbol};
   if (charInfo_.length) { // Declaration has "*length" (R723)
if (PassesSharedLocalityChecks(name, prev)) {
       MakeHostAssocSymbol(name, prev).set(Symbol::Flag::LocalityShared);
     }
   }
   return false;
 }
 
 bool ConstructVisitor::Pre(const parser::AcSpec &x) {
   ProcessTypeSpec(x.type);
-  PushScope(Scope::Kind::ImpliedDos, nullptr);
   Walk(x.values);
-  PopScope();
   return false;
 }
 
 // Section 19.4, paragraph 5 says that each ac-do-variable has the scope of the
 // enclosing ac-implied-do
 bool ConstructVisitor::Pre(const parser::AcImpliedDo &x) {
   auto &values{std::get<std::list<parser::AcValue>>(x.t)};
   auto &control{std::get<parser::AcImpliedDoControl>(x.t)};
   auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(control.t)};
   auto &bounds{std::get<parser::AcImpliedDoControl::Bounds>(control.t)};
+  // F'2018 has the scope of the implied DO variable covering the entire
+  // implied DO production (19.4(5)), which seems wrong in cases where the name
+  // of the implied DO variable appears in one of the bound expressions. Thus
+  // this extension, which shrinks the scope of the variable to exclude the
+  // expressions in the bounds.
+  auto restore{BeginCheckOnIndexUseInOwnBounds(bounds.name)};
+  Walk(bounds.lower);
+  Walk(bounds.upper);
+  Walk(bounds.step);
+  EndCheckOnIndexUseInOwnBounds(restore);
   PushScope(Scope::Kind::ImpliedDos, nullptr);
-  DeclareStatementEntity(bounds.name.thing.thing, type);
-  Walk(bounds);
+  DeclareStatementEntity(bounds.name, type);
   Walk(values);
   PopScope();
   return false;
 }
 
 bool ConstructVisitor::Pre(const parser::DataImpliedDo &x) {
   auto &objects{std::get<std::list<parser::DataIDoObject>>(x.t)};
   auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(x.t)};
   auto &bounds{std::get<parser::DataImpliedDo::Bounds>(x.t)};
-  DeclareStatementEntity(bounds.name.thing.thing, type);
-  Walk(bounds);
+  // See comment in Pre(AcImpliedDo) above.
+  auto restore{BeginCheckOnIndexUseInOwnBounds(bounds.name)};
+  Walk(bounds.lower);
+  Walk(bounds.upper);
+  Walk(bounds.step);
+  EndCheckOnIndexUseInOwnBounds(restore);
+  bool pushScope{currScope().kind() != Scope::Kind::ImpliedDos};
+  if (pushScope) {
+    PushScope(Scope::Kind::ImpliedDos, nullptr);
+  }
+  DeclareStatementEntity(bounds.name, type);
   Walk(objects);
+  if (pushScope) {
+    PopScope();
+  }
   return false;
 }
 
 // Sets InDataStmt flag on a variable (or misidentified function) in a DATA
 // statement so that the predicate IsStaticallyInitialized() will be true
 // during semantic analysis before the symbol's initializer is constructed.
 bool ConstructVisitor::Pre(const parser::DataIDoObject &x) {
   std::visit(
if (Symbol * symbol{name.symbol}) {
     symbol->set(Symbol::Flag::ImplicitOrError, false);
     if (IsUplevelReference(*symbol)) {
       MakeHostAssocSymbol(name, *symbol);
     } else if (IsDummy(*symbol) ||
         (!symbol->GetType() && FindCommonBlockContaining(*symbol))) {
       ConvertToObjectEntity(*symbol);
       ApplyImplicitRules(*symbol);
     }
+    if (checkIndexUseInOwnBounds_ &&
+        *checkIndexUseInOwnBounds_ == name.source) {
+      Say(name,
+          "Implied DO index '%s' uses an object of the same name in its bounds expressions"_en_US,
+          name.source);
+    }
     return &name;
   }
   if (isImplicitNoneType()) {
     Say(name, "No explicit type declared for '%s'"_err_en_US);
     return nullptr;
   }
   // Create the symbol then ensure it is accessible
+  if (checkIndexUseInOwnBounds_ && *checkIndexUseInOwnBounds_ == name.source) {
+    Say(name,
+        "Implied DO index '%s' uses itself in its own bounds expressions"_err_en_US,
+        name.source);
+  }
   MakeSymbol(InclusiveScope(), name.source, Attrs{});
   auto *symbol{FindSymbol(name)};
   if (!symbol) {
     Say(name,
         "'%s' from host scoping unit is not accessible due to IMPORT"_err_en_US);
     return nullptr;
   }
   ConvertToObjectEntity(*symbol);

flang/test/Semantics/array-constr-values.f90

subroutine arrayconstructorvalues()
 
   !ERROR: Item is not suitable for use in an array constructor
   intarray(1:1) = [ arrayconstructorvalues ]
 end subroutine arrayconstructorvalues
 subroutine checkC7115()
   real, dimension(10), parameter :: good1 = [(99.9, i = 1, 10)]
   real, dimension(100), parameter :: good2 = [((88.8, i = 1, 10), j = 1, 10)]
   real, dimension(-1:0), parameter :: good3 = [77.7, 66.6]
-  !ERROR: Implied DO index is active in surrounding implied DO loop and may not have the same name
+  !ERROR: Implied DO index 'i' is active in a surrounding implied DO loop and may not have the same name
   real, dimension(100), parameter :: bad = [((88.8, i = 1, 10), i = 1, 10)]
 
   !ERROR: Value of named constant 'bad2' ([INTEGER(4)::(int(j,kind=4),INTEGER(8)::j=1_8,1_8,0_8)]) cannot be computed as a constant value
   !ERROR: The stride of an implied DO loop must not be zero
   integer, parameter :: bad2(*) = [(j, j=1,1,0)]
   integer, parameter, dimension(-1:0) :: negLower = (/343,512/)
   integer, parameter, dimension(-1:0) :: negLower1 = ((/343,512/))
 

flang/test/Semantics/data11.f90

+! RUN: %flang_fc1 -fsyntax-only -fdebug-dump-symbols %s 2>&1 | FileCheck %s
+! CHECK:  Implied DO index 'j' uses an object of the same name in its bounds expressions
+! CHECK: ObjectEntity type: REAL(4) shape: 1_8:5_8 init:[REAL(4)::1._4,2._4,3._4,4._4,5._4]
+! Verify that the scope of a DATA statement implied DO loop index does
+! not include the bounds expressions (language extension, with warning)
+integer, parameter :: j = 5
+real, save :: a(j)
+data (a(j),j=1,j)/1,2,3,4,5/
+end

flang/test/Semantics/modfile25.f90

 ! module m1
 ! integer(8),parameter::a0s(1_8:*)=[INTEGER(8)::]
 ! intrinsic::shape
 ! real(4)::a1(1_8:5_8,1_8:5_8,1_8:5_8)
 ! integer(8),parameter::a1s(1_8:*)=[INTEGER(8)::5_8,5_8,5_8]
 ! integer(8),parameter::a1ss(1_8:*)=[INTEGER(8)::3_8]
 ! integer(8),parameter::a1sss(1_8:*)=[INTEGER(8)::1_8]
 ! integer(8),parameter::a1rs(1_8:*)=[INTEGER(8)::3_8,1_8,1_8,1_8]
+! intrinsic::rank
 ! integer(8),parameter::a1n(1_8:*)=[INTEGER(8)::125_8,5_8,5_8]
+! intrinsic::size
 ! integer(8),parameter::a1sn(1_8:*)=[INTEGER(8)::3_8,1_8,1_8]
 ! integer(8),parameter::ac1s(1_8:*)=[INTEGER(8)::1_8]
 ! integer(8),parameter::ac2s(1_8:*)=[INTEGER(8)::3_8]
 ! integer(8),parameter::ac3s(1_8:*)=[INTEGER(8)::4_8]
 ! integer(8),parameter::ac3bs(1_8:*)=[INTEGER(8)::4_8]
 ! integer(8),parameter::ac4s(1_8:*)=[INTEGER(8)::36_8]
 ! integer(8),parameter::ac5s(1_8:*)=[INTEGER(8)::9_8]
 ! integer(8),parameter::rss(1_8:*)=[INTEGER(8)::10_8,9_8]
 ! intrinsic::reshape
 ! contains
 ! subroutine subr(x,n1,n2)
 ! real(4),intent(in)::x(:,:)
 ! integer(4),intent(in)::n1(1_8:3_8)
 ! integer(4),intent(in)::n2(:)
 ! end
 ! end

flang/test/Semantics/modfile26.f90

integer, parameter :: realdigits(*) = &
     [digits(0._2), digits(0._3), digits(0._4), digits(0._8), digits(0._10), &
      digits(0._16)]
   logical, parameter :: realdigitscheck = &
     all([11, 8, 24, 53, 64, 113] == realdigits)
 end module m1
 !Expect: m1.mod
 !module m1
 !integer(4),parameter::iranges(1_8:*)=[INTEGER(4)::2_4,4_4,9_4,18_4,38_4]
+!intrinsic::range
 !logical(4),parameter::ircheck=.true._4
 !intrinsic::all
 !integer(4),parameter::intpvals(1_8:*)=[INTEGER(4)::0_4,2_4,3_4,4_4,5_4,9_4,10_4,18_4,19_4,38_4,39_4]
 !integer(4),parameter::intpkinds(1_8:*)=[INTEGER(4)::1_4,1_4,2_4,2_4,4_4,4_4,8_4,8_4,16_4,16_4,-1_4]
+!intrinsic::size
 !logical(4),parameter::ipcheck=.true._4
 !integer(4),parameter::realprecs(1_8:*)=[INTEGER(4)::3_4,2_4,6_4,15_4,18_4,33_4]
+!intrinsic::precision
 !logical(4),parameter::rpreccheck=.true._4
 !integer(4),parameter::realpvals(1_8:*)=[INTEGER(4)::0_4,3_4,4_4,6_4,7_4,15_4,16_4,18_4,19_4,33_4,34_4]
 !integer(4),parameter::realpkinds(1_8:*)=[INTEGER(4)::2_4,2_4,4_4,4_4,8_4,8_4,10_4,10_4,16_4,16_4,-1_4]
 !logical(4),parameter::realpcheck=.true._4
 !integer(4),parameter::realranges(1_8:*)=[INTEGER(4)::4_4,37_4,37_4,307_4,4931_4,4931_4]
 !logical(4),parameter::rrangecheck=.true._4
 !integer(4),parameter::realrvals(1_8:*)=[INTEGER(4)::0_4,4_4,5_4,37_4,38_4,307_4,308_4,4931_4,4932_4]
 !integer(4),parameter::realrkinds(1_8:*)=[INTEGER(4)::2_4,2_4,3_4,3_4,8_4,8_4,10_4,10_4,-2_4]
 !logical(4),parameter::realrcheck=.true._4
 !logical(4),parameter::radixcheck=.true._4
+!intrinsic::radix
 !integer(4),parameter::intdigits(1_8:*)=[INTEGER(4)::7_4,15_4,31_4,63_4,127_4]
+!intrinsic::digits
 !logical(4),parameter::intdigitscheck=.true._4
 !integer(4),parameter::realdigits(1_8:*)=[INTEGER(4)::11_4,8_4,24_4,53_4,64_4,113_4]
 !logical(4),parameter::realdigitscheck=.true._4
 !end

flang/test/Semantics/resolve106.f90

+!RUN: %flang -fsyntax-only %s 2>&1 | FileCheck %s
+integer, parameter :: j = 10
+! CHECK: Implied DO index 'j' uses an object of the same name in its bounds expressions
+real :: a(10) = [(j, j=1,j)]
+end

flang/test/Semantics/resolve30.f90

block
     real :: a(16) = [(i, i=1, 16)]
     real :: b(16)
     !ERROR: No explicit type declared for 'j'
     data(b(j), j=1, 16) / 16 * 0.0 /
   end block
 end
 
 subroutine s4
-  real :: i, j
+  real :: j
   !ERROR: Must have INTEGER type, but is REAL(4)
-  real :: a(16) = [(i, i=1, 16)]
+  real :: a(16) = [(x, x=1, 16)]
   real :: b(16)
   !ERROR: Must have INTEGER type, but is REAL(4)
   data(b(j), j=1, 16) / 16 * 0.0 /
 end

flang/test/Semantics/symbol05.f90

 !DEF: /s3 (Subroutine) Subprogram
 subroutine s3
  !DEF: /s3/j ObjectEntity INTEGER(8)
  integer(kind=8) j
  block
   !DEF: /s3/Block1/t DerivedType
   type :: t
    !DEF: /s3/Block1/t/x ObjectEntity REAL(4)
-   !DEF: /s3/Block1/t/ImpliedDos1/ImpliedDos1/i (Implicit) ObjectEntity INTEGER(4)
+   !DEF: /s3/Block1/t/ImpliedDos1/i (Implicit) ObjectEntity INTEGER(4)
    real :: x(10) = [(i, i=1,10)]
    !DEF: /s3/Block1/t/y ObjectEntity REAL(4)
-   !DEF: /s3/Block1/t/ImpliedDos2/ImpliedDos1/j ObjectEntity INTEGER(8)
+   !DEF: /s3/Block1/t/ImpliedDos2/j ObjectEntity INTEGER(8)
    real :: y(10) = [(j, j=1,10)]
   end type
  end block
 end subroutine
 
 !DEF: /s4 (Subroutine) Subprogram
 subroutine s4
  implicit integer(x)